Using For loop to return named charts from other sheets

Question

I'm trying to use a For loop to copy/paste named charts with the same name as the reference cell and the function below returns the correct chart but is just copy/pasting the chart in question 36 times (the number of worksheets in my document). Am I using the wrong function to begin with?

Dim aChar As ChartObject 'these lines define the name of the chart
Dim aFlag As Boolean
Dim aCharName As String
On Error Resume Next
Application.ScreenUpdating = False
aCharName = (Sheets("Sheet1").Range("A1"))
aFlag = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets 'The For Loop: I think this is where the problem is

If aChar.Name = aCharName Then

ws.ChartObjects(Sheets("Sheet1").Range("A1")).Activate
ActiveChart.ChartArea.Copy 'from now on the simple copy/paste 
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Pictures.Paste

End If

Next

many thanks

a) avoid select/activate: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba , b) unless you have multiple charts that can be pasted, you most likely want something to exit the subroutine once a chart has been found/pasted, and c) this loop would be appropriate as you do need to go sheet by sheet to find a shape — Cyril, Feb 25 '19 at 15:25
You say "function" but no function is being called, so what you mean is unclear. Also, you set aCharName before the loop and never set it again, so you will only copy/paste that one chart. Does your reference cell contain a formula that you aren't sharing? — n8., Feb 25 '19 at 15:43

Xabier · Answer 1 · 2019-02-26T08:14:17.920

How about the following, not only will it loop through your worksheets, but then check and loop through your charts in each worksheet before checking if the name matches, and if so paste the chart in the next available row in Column A of Sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim aFlag As Boolean: aFlag = False
Dim aCharName As String: aCharName = Sheets("Sheet1").Range("A1").Value
Dim i As Long
Dim ws As Worksheet
'On Error Resume Next
Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets 'The For Loop: I think this is where the problem is
        If ws.ChartObjects.Count > 0 Then 'check if there are any charts in worksheet
            For i = 1 To ws.ChartObjects.Count 'loop through charts
                If ws.ChartObjects.Name = aCharName Then
                    ws.ChartObjects(aCharName).ChartArea.Copy 'from now on the simple copy/paste
                    LastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row ' get the last row
                    Sheets("Sheet1").Select
                    Sheets("Sheet1").Range("A" & LastRow).Select
                    ActiveSheet.Pictures.Paste 'paste in the new last row
                    'probably best to use Offset to paste for the next iteration of the For Loop
                End If
            Next i
        End If
    Next
Application.ScreenUpdating = True
End Sub

The program freezes when I use this code. In fact, when I try to get rid of some of the .selects the program also freezes. I should note that I am using data validation so it's a sheet change sub. — A.S., Feb 26 '19 at 07:56
@A.S. I've now updated my answer, I believe this should now work as intended, do try and let me know if any issues. Thanks :) — Xabier, Feb 26 '19 at 08:14
thanks, but this time I get 30+ texboxes at A2 stating Sheet1 — A.S., Feb 26 '19 at 10:24
I think the problem is in the Loop. It basically copies and pastes the chart as many times as there are sheets in the document — A.S., Feb 26 '19 at 10:24

Using For loop to return named charts from other sheets

1 Answers1