CODEWITHSUNDEEP
excelvbaseries
Zacchini
Zacchini

Reputation: 143

VBA code to change/adjust multiple charts' series names (duplicate column headings)

I have a VBA that creates multiple line charts from a spreadsheet. Each chart is for a different characteristic which has two columns to calculate 20th and 80th percentiles. As there are multiple columns with the same name, duplicate columns are named 20th Percentile1, 20th Percentile2... etc etc. Like below:column titles

Because of this, after running my graph VBA, I end up with series legends like this:series legend I was wondering if there was a code that adjusts the series name to exclude the duplicate numbers, so they all have just 20th Percentile and 80th Percentile.

The main issue is, that I have other series like "Min," "Max," "Limit A," and "Limit B." So I don't want to change those series. Just the duplicate ones.

Here is my code:

Sub Graph()

' Creates scatter chart with provided limit/percentile values
'

    Dim my_range    As Range, t

    t = Selection.Cells(1, 1).Value + " - " + ActiveSheet.Name
    
    Dim OldSheet As Worksheet
    Set OldSheet = ActiveSheet

    Set my_range = Union(Selection, ActiveSheet.Range("A:A"))
    ActiveSheet.Shapes.AddChart2(201, xlLine).Select
    With ActiveChart
        .FullSeriesCollection(1).ChartType = xlLine
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .SetSourceData Source:=my_range
        .HasTitle = True
        .ChartTitle.Text = t
        .Location Where:=xlLocationAsObject, Name:="Graphs"
    End With
    OldSheet.Activate

    
End Sub

have tried adding:

    If .FullSeriesCollection(1).Name Like "20th Percentile*" Then
        .FullSeriesCollection(1).Name = "20th Percentile"
    End If

with no luck

Upvotes: 0

Views: 324

Answers (1)

Tim Williams
Tim Williams

Reputation: 166331

Here's a more worked-out example:

Sub Graph()

    Dim my_range As Range, t, co As Shape '<edit

    t = Selection.Cells(1, 1).Value + " - " + ActiveSheet.Name

    Dim OldSheet As Worksheet
    Set OldSheet = ActiveSheet

    Set my_range = Union(Selection, ActiveSheet.Range("A:A"))

    Set co = ActiveSheet.Shapes.AddChart2(201, xlLine) 'add a ChartObject
    With co.Chart
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .SetSourceData Source:=my_range
        .HasTitle = True
        .ChartTitle.Text = t
        ResolveSeriesnames co.Chart 'edit: move this before the .Location line 
        .Location Where:=xlLocationAsObject, Name:="Graphs"
    End With

    OldSheet.Activate
End Sub

'Given a Chart object, loop over its series
'  and check for Names that start with some
'  common root text: if found use the root as the name
Sub ResolveSeriesnames(cht As Chart)
    Dim s As Series, arr, e
    'list of root names to look for
    arr = Array("20th Percentile", "80th Percentile")
    For Each s In cht.SeriesCollection
        For Each e In arr
            If s.Name Like e & "*" Then
                s.Name = e
                Exit For
            End If
        Next e
    Next s
End Sub

Upvotes: 1

Related Questions