Is there a way to list chart numbers based on position in the spreadsheet? (Not in sorted order?) - excel

Question

The following macro lists all the chart numbers of by worksheet but it order them and this is not how the charts appear in the sheet.
Sub ListChartNames()
Dim Cht As ChartObject
Dim i As Integer
i = 1
For Each Cht In ActiveSheet.ChartObjects
Cells(i, 1) = Cht.Chart.Name
i = i + 1
Next Cht
End Sub
For example, I have a chart in E6:L17 (let's call this one Chart 1) and another in N6:U17 (let's call this one Chart 11).
Then, I move down to two charts in E19:L30 (let's call this one Chart 400) and another in N19:U30 (let's call this one Chart 2).
Then, I move down to two charts in E32:L43 (let's call this one Chart 3) and another in N32:U43 (let's call this one Chart 12)
Then, I move down to only 1 chart in E45:L56 (let's call this one Chart 13)
Then, I back to two charts in E58:L69 and another in N58:U69 (let's call these Chart 15 and Chart 16)
and so on.....
The above charts are all in columns E through U. But then there is another set in columns Y through AO in same patter and again in AS through BI, etc.
I have like 500 charts and I'd like a macro to list them starting in the first set of columns (E through L) but list them from top to bottom, let to right.
So, the results based on the above would be for columns F through U
Chart 1
Chart 11
Chart 400
Chart 2
Chart 3
Chart 12
Chart 13
Chart 15
Chart 16
The macro above lists the charts in a sorted order which is not what I need.
This also doesn't answer the question: Select chart object based on position in sheet (VBA)

Answer 1

Does this give you what you need?
Sub list_charts_in_top_left_to_bottom_right()
Dim ws As Worksheet, outputsh As Worksheet, last_cell As Range, oChartObj As Object
Set ws = ThisWorkbook.Sheets("SheetWithChartsOnIt")
Set outputsh = ThisWorkbook.Sheets("SheetToWriteTo")
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")
'find bounds of range by expanding last_cell with each chart
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
Dim area_to_examine As Range
For col = 5 To last_cell.Column Step 21 'start with column 5 (E) and then jump 21 columns at a time
Set area_to_examine = Range(Columns(col), Columns(col + 17))
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

Answer 2

This is an alternative method. It's still not using a sort algo, but uses a workaround which (does waste a little time but) should be massively quicker than scanning every cell in the sheet:
Sub list_charts_in_top_left_to_bottom_right_v2()
Dim ws As Worksheet, outputsh As Worksheet, chartCount As Long, x As Long, y As Long, maxZ As Long
Set ws = ThisWorkbook.Sheets("SheetWithChartsOnIt")
Set outputsh = ThisWorkbook.Sheets("SheetToWriteTo")
outputsh.Range("A:A").ClearContents
outputsh.Range("A1").Value = "Chart"
chartCount = ws.ChartObjects.Count
ReDim arrChartlist(chartCount, 1)
If chartCount = 0 Then
outputsh.Range("A2") = "No charts found"
Exit Sub
End If
maxZ = 0
For x = 0 To chartCount - 1
With ws.ChartObjects(x + 1)
arrChartlist(x, 0) = .Name
arrChartlist(x, 1) = (((.TopLeftCell.Column - 2) \ 19) * chartCount * chartCount) + (.TopLeftCell.Column * chartCount) + .TopLeftCell.Row
If maxZ < arrChartlist(x, 1) Then maxZ = arrChartlist(x, 1)
End With
Next
For x = 0 To maxZ
For y = 0 To chartCount - 1
If x = arrChartlist(y, 1) Then
outputsh.Cells(outputsh.Rows.Count, "A").End(xlUp).Offset(1).Value = arrChartlist(y, 0)
End If
Next
Next
End Sub