I cannot seem to rename charts in Excel

[brianhfield]

I have a sheet (call it sheet1) with 235 charts. The first chart is in cells D5 through L17 and is named Chart1 in the circled area. This is actually what I want this chart to be named/called.

The second chart starts in cell D19 and spans cells D19 through L31. This chart is named Chart233 (see second image). I am trying to write a code that will rename all the carts on the page from Chart 1 to Chart235 from the top of the sheet to the bottom of the sheet. So, the code needs to examine the upper left cells in column D only as all charts on the sheet start in column D and they just continue below the previous chart.

The below code is what I tried but still leaves the second chart named Chart233. Any thoughts?

Sub ResetChartObjectNames()

    Dim cht As ChartObject
    Dim chartName As String
    Dim counter As Integer

    ' Set starting counter and chart name
    counter = 1
    chartName = "Chart" & counter

    ' Loop through all chart objects on the worksheet
    For Each cht In ActiveSheet.ChartObjects

        ' Update chart object name based on counter
        cht.Name = chartName

        ' Increase counter for next chart
        counter = counter + 1
        chartName = "Chart" & counter

    Next cht

End Sub

 

[bobsan42]

there is a way to rename some objects on the worksheet:
on the ribbon: Editing group>Find & Select > Selection Pane ...

in the Selection pane you can rename or show/hide the listed objects.

Note: The fact that you see the chart as second on the page does not mean it is the second chart object on the worksheet. So your code probably works correctly, but Chart2 is probably further down.

 

[brianhfield]

Thanks - that is quite a hidden pane. Unfortunately, this is a manual solution.....I suppose I'll record this and see if that illuminates anything.
Thanks!

 

[brianhfield]

Would really like a vba code that will do it programmatically....

 

[bobsan42]

Try if this works:

Sub RenameChartsByVisualOrder()
    'This will check all charts, and will change their names accroding to the order they appear visually on the sheet (1 column,top to bottom)
    'bobsan42® 2024-03-29
    Dim i As Long, txt As String
    Const prefix = "Chart" 'Change to your liking
    Dim cht As ChartObject
    Dim arr() As Variant
    ReDim arr(1 To 4, 1 To 1)
   
    For Each cht In ActiveSheet.ChartObjects
        i = i + 1
        ReDim Preserve arr(1 To 4, 1 To i)
        With cht
            txt = .TopLeftCell.Address
            arr(1, i) = .Index
            arr(2, i) = .Name
            arr(3, i) = Split(txt, "$")(1)
            arr(4, i) = CLng(Split(txt, "$")(2))
        End With
    Next cht
    arr = WorksheetFunction.Transpose(arr)
    QuickSortArray arr, , , 4 'taken from : https://stackoverflow.com/questions/4873182/sorting-a-multidimensionnal-array-in-vba
    'ActiveCell.Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    With ActiveSheet
        For i = LBound(arr, 1) To UBound(arr, 1)
            With .ChartObjects(arr(i, 1))
                '.Select
                .Name = prefix & i
                '.Chart.ChartTitle.Caption = .Name
            End With
        Next i
    End With
    Set cht = Nothing
    Erase arr
End Sub

You also need this sub (I used it as it was posted here):

Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
    On Error Resume Next
    'Sort a 2-Dimensional array

    ' SampleUsage: sort arrData by the contents of column 3
    '
    '   QuickSortArray arrData, , , 3

    '
    'Posted by Jim Rech 10/20/98 Excel.Programming

    'Modifications, Nigel Heffernan:

    '       ' Escape failed comparison with empty variant
    '       ' Defensive coding: check inputs

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp

            i = i + 1
            j = j - 1
        End If
    Wend

    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
   
End Sub

 

[brianhfield]

Try if this works:

Sub RenameChartsByVisualOrder()
    'This will check all charts, and will change their names accroding to the order they appear visually on the sheet (1 column,top to bottom)
    'bobsan42® 2024-03-29
    Dim i As Long, txt As String
    Const prefix = "Chart" 'Change to your liking
    Dim cht As ChartObject
    Dim arr() As Variant
    ReDim arr(1 To 4, 1 To 1)
  
    For Each cht In ActiveSheet.ChartObjects
        i = i + 1
        ReDim Preserve arr(1 To 4, 1 To i)
        With cht
            txt = .TopLeftCell.Address
            arr(1, i) = .Index
            arr(2, i) = .Name
            arr(3, i) = Split(txt, "$")(1)
            arr(4, i) = CLng(Split(txt, "$")(2))
        End With
    Next cht
    arr = WorksheetFunction.Transpose(arr)
    QuickSortArray arr, , , 4 'taken from : https://stackoverflow.com/questions/4873182/sorting-a-multidimensionnal-array-in-vba
    'ActiveCell.Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    With ActiveSheet
        For i = LBound(arr, 1) To UBound(arr, 1)
            With .ChartObjects(arr(i, 1))
                '.Select
                .Name = prefix & i
                '.Chart.ChartTitle.Caption = .Name
            End With
        Next i
    End With
    Set cht = Nothing
    Erase arr
End Sub

You also need this sub (I used it as it was posted here):

Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
    On Error Resume Next
    'Sort a 2-Dimensional array

    ' SampleUsage: sort arrData by the contents of column 3
    '
    '   QuickSortArray arrData, , , 3

    '
    'Posted by Jim Rech 10/20/98 Excel.Programming

    'Modifications, Nigel Heffernan:

    '       ' Escape failed comparison with empty variant
    '       ' Defensive coding: check inputs

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp

            i = i + 1
            j = j - 1
        End If
    Wend

    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
  
End Sub

Thank you! This is fantastic!!! Much appreciated.

 

[NdNoviceHlp]

Hi *brianhfield. I trialed your code and it renames all charts. I'm guessing the reason that your second chart gets renamed Chart 233 is because it was actually Chart 232 to begin with and was re-ordered in the presentation (or chart 2 was deleted and then re-made as the final chart). I like bobsan42's approach. There is also a TopLeftCell.Row property that may have been useful. HTH. Dave
ps. I see this is resolved. Glad you got it worked out.

 

[bobsan42]

There is also a TopLeftCell.Row property that may have been useful.

Sometimes we miss the obvious ... Thanks
Still, having also the column name (or number) may come in handy when objects are not arranged in one column.