Macro to list out chart names into a sheet column

[BuJay]

I thought I asked this question here but I can't find it....

I have a macro that examines charts in columns D through T, and then W through AM, and this continues until columns JJ through JZ. There are 15 groups of charts.

The code below lists the charts from upper left to lower right in columns D throgh T....then it lists out the charts from upper left to lower right in columns W through AM, and so on....

The code works....but it is EXTREMELY slow....does anyone see anything here that could be adjusted to speed it up?

Thanks!

Option Explicit

Sub list_charts()
   
    Dim ws As Worksheet
    Dim outputsh As Worksheet
    Dim last_cell As Range
    Dim oChartObj As Object
    Dim area_to_examine As Range
    Dim col As Long
    Dim rw As Object
    Dim cl As Object
   
    Set ws = ThisWorkbook.Sheets("charts")
    Set outputsh = ThisWorkbook.Sheets("charts")
   
    Sheets("charts").Activate
    outputsh.Range("A:A").ClearContents
    outputsh.Range("A1") = "Output:"
   
    If ws.ChartObjects.Count = 0 Then
        outputsh.Range("A2") = "No charts found"
        Exit Sub
    End If
   
    Debug.Print "Charts found: " & ws.ChartObjects.Count
   
    Set last_cell = ws.Range("A1")
   
    For Each oChartObj In ws.ChartObjects
       
        With oChartObj
       
            If .TopLeftCell.Row > last_cell.Row _
                Then Set last_cell = ws.Cells(.TopLeftCell.Row, last_cell.Column)
           
            If .TopLeftCell.Column > last_cell.Column _
                Then Set last_cell = ws.Cells(last_cell.Row, .TopLeftCell.Column)
       
        End With
       
    Next
   
    Debug.Print "Bounds of range: $A$1:" & last_cell.Address


    'start with column 4 (D) and then jump 19 columns at a time
    For col = 4 To last_cell.Column Step 19

    Set area_to_examine = Range(Columns(col), Columns(col + 16))

    Debug.Print "Examining: " & area_to_examine.Address

        For Each rw In Intersect(area_to_examine, ws.Range("A1", last_cell.Address).Rows)

            For Each cl In rw.Cells

                For Each oChartObj In ws.ChartObjects

                    With oChartObj
                        If .TopLeftCell.Row = cl.Row And .TopLeftCell.Column = cl.Column Then
                        outputsh.Cells(outputsh.Rows.Count, "A").End(xlUp).Offset(1) = .Name
                        Debug.Print .Name
                        End If
                    End With

                Next

            Next

        Next
   
    Next

End Sub

 

[BuJay]

In your image I see that you have data in rows 1 and 2. I just want you to confirm if you have data in those rows, the macro needs it to calculate the last column with data.

View attachment 93327

I can have data in in A1 and B1 as headers but they aren't needed from my perspective. If they are needed for the code, then I can add headers there.

However, your last code worked immediately, so I marked it as a solution. Thanks so much @DanteAmor