Naming multiple chart series easily

[Peter Davison]

I have a chart with over 100 series (some used at variable times depending on the data) and I wondered if there was a quick way to name each series rather than opening each series and selecting the cell with the name?
I looked on google but all the charts they were showing had just a few series so easy to name them.
Thanks for your help?

 

[BSALV]

suppose the names are in A1:A100

Sub Name_Series()
     With ActiveSheet.ChartObjects("Name of the chart").Chart
          For i = 1 To .SeriesCollection.Count
               .SeriesCollection(i).Name = Range("A" & i).Value
          Next
     End With
End Sub

 

[Peter Davison]

When I ran the above code it seemed to not run correctly.
My list is like the below with gaps that would be a series when they are used and starts at B6 through to B204.
My graph is like the below and as you can see its put an odd one in with some zeros.
Any thoughts what might not be working? Should it need to clear what might be in a series first?
Appreciate your help

 

[BSALV]

1st macro writes the parameters of your chart (defined by its name or index number) to Range("A1") + x rows by 6 columns.
You may change this A1 to another cell.

Then you change the name of the series in the 6th and empty column.
The macro renames only those series with something in that 6th column, so if you want to delete a seriename, add a single space here.

When that is done, look if the topleftcell is the same if you modified A1 in the previous macro !
Run the 2nd macro

Sub Collect_Names_Series()
     Dim arr()
     With ActiveSheet.ChartObjects(1).Chart                     'name of the chart or indexnumber
          cnt = .SeriesCollection.Count                         'number of series
          ReDim arr(cnt, 1 To 6)                                'redim the array
          arr(0, 1) = "name or range"                           'headers for the array
          arr(0, 2) = "X-range"
          arr(0, 3) = "Y-range"
          arr(0, 4) = "Index-number"
          arr(0, 5) = "Name"
          arr(0, 6) = "Give here the new name !!!!"
          For i = 1 To .SeriesCollection.Count
               sp = Split(Replace(Replace(.SeriesCollection(i).Formula, "(", ","), ")", ","), ",")     'use the formula of the serie and split it on "(", ")" and ","
               For j = 1 To 4: arr(i, j) = sp(j): Next          'copy the relevant parts to the array
               arr(i, 5) = .SeriesCollection(i).Name            'the real content of the serie-name
          Next

          With Range("A1").Resize(UBound(arr) + 1, UBound(arr, 2))     'write array to this cell + as many rows as series (depends on the chart) and as many columns as in the array (6 now)
               .Value = arr
               .EntireColumn.AutoFit
          End With
     End With
End Sub

Sub Rename_Series()
     'run this macro after using previous macro and renaming the series in the column right to the column "Name"
     With ActiveSheet.ChartObjects(1).Chart                     'name of the chart or indexnumber
          For i = 1 To .SeriesCollection.Count
               .SeriesCollection(i).Name = Range("A1").Offset(i, 5).Value     'range("A1") is the same cell as in previous macro
          Next
     End With
End Sub

 

[Peter Davison]

I'm not sure what happened when I ran the code.
I changed the A1 to read B1 which is the column with the series names in.
See below before and after result -

I think its because I have data in areas where you have told the code to put things?
Any thoughts?
Thanks

Before

After code -

 

[BSALV]

to be sure that there is no interference with existing data, i use now the cell BA1 for this.
If that is still in the existing data, use another cell in both macros.

I don't know what type of graph you are using and i see several series without a Y-range.
So the rename-macro renames only if you specified a new name and with a known Y-range.

Sub Collect_Names_Series()
     Dim Arr()
     With ActiveSheet.ChartObjects(1).Chart                     'name of the chart or indexnumber
          cnt = .SeriesCollection.Count                         'number of series
          ReDim Arr(cnt, 1 To 6)                                'redim the array
          Arr(0, 1) = "name or range"                           'headers for the array
          Arr(0, 2) = "X-range"
          Arr(0, 3) = "Y-range"
          Arr(0, 4) = "Index-number"
          Arr(0, 5) = "Name"
          Arr(0, 6) = "Give here the new name !!!!"
          For i = 1 To .SeriesCollection.Count
               sp = Split(Replace(Replace(.SeriesCollection(i).Formula, "(", ","), ")", ","), ",")     'use the formula of the serie and split it on "(", ")" and ","
               For j = 1 To 4: Arr(i, j) = sp(j): Next          'copy the relevant parts to the array
               Arr(i, 5) = .SeriesCollection(i).Name            'the real content of the serie-name
          Next

          With Range("BA1").Resize(UBound(Arr) + 1, UBound(Arr, 2))     'write array to this cell + as many rows as series (depends on the chart) and as many columns as in the array (6 now)
               .Value = Arr
               .EntireColumn.AutoFit
          End With
     End With
End Sub

Sub Rename_Series()
     'run this macro after using previous macro and renaming the series in the column right to the column "Name"
     Set c = Range("BA1")                                       'range("A1") is the same cell as in previous macro !!!!!!!!!!!!!!!!!!
     With ActiveSheet.ChartObjects(1).Chart                     'name of the chart or indexnumber
          For i = 1 To .SeriesCollection.Count
               If Len(c.Offset(i, 5).Value) > 0 And Len(c.Offset(i, 2).Value) > 0 Then .SeriesCollection(i).Name = c.Offset(i, 5).Value     'change only those series with something in the 3rd and the 6th column 
          Next
     End With
End Sub

 

[Peter Davison]

This has worked really well.
Thank you for all your effort it is really appreciated.

One other question -
Because I have a lot of gaps that are blank for this set of data.
Do you know if there is a way of not showing the zeros in the legend on the chart?
See below

 

[BSALV]

just supposing that the series with no "Y-range" are useless.
Otherwise explain me why some series should be treated different.

Lightly different, now with fullseriescollection instead of seriescollection and in the 2nd "renaming" macro, all the series without a Y-range are filtered (=invisible) now

Sub Collect_Names_Series()
     Dim Arr()
     With ActiveSheet.ChartObjects(1).Chart                     'name of the chart or indexnumber
          cnt = .FullSeriesCollection.Count                     'number of series
          ReDim Arr(cnt, 1 To 6)                                'redim the array
          Arr(0, 1) = "name or range"                           'headers for the array
          Arr(0, 2) = "X-range"
          Arr(0, 3) = "Y-range"
          Arr(0, 4) = "Index-number"
          Arr(0, 5) = "Name"
          Arr(0, 6) = "Give here the new name !!!!"
          For i = 1 To cnt
               sp = Split(Replace(Replace(.FullSeriesCollection(i).Formula, "(", ","), ")", ","), ",")     'use the formula of the serie and split it on "(", ")" and ","
               For j = 1 To 4: Arr(i, j) = sp(j): Next          'copy the relevant parts to the array
               Arr(i, 5) = .FullSeriesCollection(i).Name        'the real content of the serie-name
          Next

          With Range("BA1").Resize(UBound(Arr) + 1, UBound(Arr, 2))     'write array to this cell + as many rows as series (depends on the chart) and as many columns as in the array (6 now)
               .Value = Arr
               .EntireColumn.AutoFit
          End With
     End With
End Sub


Sub Rename_Series()
     'run this macro after using previous macro and renaming the series in the column right to the column "Name"
     Set c = Range("BA1")                                       'range("A1") is the same cell as in previous macro !!!!!!!!!!!!!!!!!!
     With ActiveSheet.ChartObjects(1).Chart                     'name of the chart or indexnumber
          For i = 1 To .FullSeriesCollection.Count
               If Len(c.Offset(i, 2).Value) = 0 Then            'no given Y-range
                    .FullSeriesCollection(i).IsFiltered = True  '=don't show this serie at all
               ElseIf Len(c.Offset(i, 5).Value) > 0 Then .FullSeriesCollection(i).Name = c.Offset(i, 5).Value     'change only those series with something in the 6th column
               End If
          Next
     End With
End Sub

 

[Peter Davison]

Just before I run the macro.
Each category that is run will have an amount of different entries, so for the Breakfast Cereals it was about 12 entries on the first graph bar by cluster number and only 3 entries on the second graph bar.
However, if I ran say soups it may be 8 on the first and 10 on the second.
So all are needed but at different time depending on the category.

Does that help.
If you can advise before I run the second code (Or do I just run the code each time there is a new category)?
Thank you again for all of your help.
It has been such a bonus for me.