changes to chart series numbers

S

sulley333

Board Regular
Joined
Apr 29, 2010
Messages
71
I am creating a chart but won't always know how many data series I will have...does anyone know how to adjust the code below so that it can account for changes in the number of series?


Code: 
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).XValues = "='Comparison Analysis Data'!$A$6:$A$" & chartrow - 1
    ActiveChart.SeriesCollection(1).Values = "='Comparison Analysis Data'!$B$6:$B$" & chartrow - 1
    ActiveChart.SeriesCollection(2).Values = "='Comparison Analysis Data'!$C$6:$C$" & chartrow - 1
 
Sort by date Sort by votes
Ok...so I wasn't exactly sure what you are looking for so here is the entire code that I have to create the chart...I hope this helps!

Code: 
Sub create_comp_chart_data()
Dim ws_data As Worksheet, ws_comp_chart As Worksheet, ws_comp As Worksheet
Dim brand As String, caption As String, foundation As String, attrib As String
Dim wf As WorksheetFunction, Combo_Brand As ComboBox, Combo_Attrib As ComboBox, rnum As Integer
Dim chartrow As Integer, pI As PivotItem, ctlx, ctly, iX As Integer, iY As Integer
Dim ctlz, iZ As Integer, cnum As Integer
Dim sSelectedCaption As String, sSelectedFoundation As String, sSelectedBrand As String
Dim ListBox_Foundation_Caption As ListBox, Listbox_Caption_Comp As ListBox, ListBox_Brand_Comp As ListBox
 
    Set ws_data = ThisWorkbook.Worksheets("All Coded Data")
    Set ws_comp_chart = ThisWorkbook.Worksheets("Comparison Analysis Data")
    Set ws_comp = ThisWorkbook.Worksheets("Comparison Analysis")
    Set wf = Application.WorksheetFunction
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
 
brand = ws_comp.Cells(13, 8).Value
caption = ws_comp.Cells(14, 8).Value
foundation = ws_comp.Cells(15, 8).Value
attrib = ws_comp.Cells(19, 8).Value
If brand = "" Then brand = "(All)"
If caption = "" Then caption = "(All)"
If foundation = "" Then foundation = "(All)"
If attrib = "" Then MsgBox ("Need to select attribute to create chart")
    Set ctlx = ws_comp.Shapes("ListBox_Caption_Comp").OLEFormat.Object
    Set ctly = ws_comp.Shapes("ListBox_Foundation_Comp").OLEFormat.Object
    Set ctlz = ws_comp.Shapes("ListBox_Brand_Comp").OLEFormat.Object
 
    'Is at least one item in listbox selected?
    For iX = 0 To ctlx.Object.ListCount - 1
        If ctlx.Object.Selected(iX) Then
            sSelectedCaption = ctlx.Object.List(iX)
            Exit For
        End If
    Next
    For iY = 0 To ctly.Object.ListCount - 1
        If ctly.Object.Selected(iY) Then
            sSelectedFoundation = ctly.Object.List(iY)
            Exit For
        End If
    Next
    For iZ = 0 To ctlz.Object.ListCount - 1
        If ctlz.Object.Selected(iZ) Then
            sSelectedBrand = ctlz.Object.List(iZ)
            Exit For
        End If
    Next
 
 
rnum = ws_data.Range("C1").CurrentRegion.Rows.Count - 1
ws_data.Activate
Range(Cells(1, 1), Cells(rnum, 87)).Name = "Data_Range"
Sheets("Comparison Analysis Data").Visible = True
ws_comp_chart.Select
Cells.Select
Selection.Delete Shift:=xlUp
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "=Data_Range").CreatePivotTable TableDestination:=Range("A3"), TableName:= _
        "PivotTable1"
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Major Caption")
        .Orientation = xlPageField
        .Position = 1
    End With
 
                    If sSelectedCaption <> "(All)" Then
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("Major Caption")
 
            'Set that item visible
            .PivotItems(sSelectedCaption).Visible = True
 
            'Set that item visible all others not - procedure appears to be duplicative, but
            'have to ensure at least one item is visible.
            For Each pI In .PivotItems
                Select Case UCase(pI.Name)
                Case UCase(sSelectedCaption)
                    pI.Visible = True
                Case Else
                    pI.Visible = False
              End Select
            Next pI
 
            'Turn on all that are selected
            For iX = 0 To ctlx.Object.ListCount - 1
                If ctlx.Object.Selected(iX) Then
                    .PivotItems(ctlx.Object.List(iX)).Visible = True
                End If
            Next
        End With
                End If
 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Foundation")
        .Orientation = xlPageField
        .Position = 1
    End With
 
                If sSelectedCaption <> "(All)" Then
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("Foundation")
 
            'Set that item visible
            .PivotItems(sSelectedFoundation).Visible = True
 
            'Set that item visible all others not - procedure appears to be duplicative, but
            'have to ensure at least one item is visible.
            For Each pI In .PivotItems
                Select Case UCase(pI.Name)
                Case UCase(sSelectedFoundation)
                    pI.Visible = True
                Case Else
                    pI.Visible = False
              End Select
            Next pI
 
            'Turn on all that are selected
            For iY = 0 To ctly.Object.ListCount - 1
                If ctly.Object.Selected(iY) Then
                    .PivotItems(ctly.Object.List(iY)).Visible = True
                End If
            Next
        End With
                End If
 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Brand")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Brand")
    .PivotItems(sSelectedBrand).Visible = True
 
            'Set that item visible all others not - procedure appears to be duplicative, but
            'have to ensure at least one item is visible.
            For Each pI In .PivotItems
                Select Case UCase(pI.Name)
                Case UCase(sSelectedBrand)
                    pI.Visible = True
                Case Else
                    pI.Visible = False
              End Select
            Next pI
 
            'Turn on all that are selected
            For iZ = 0 To ctlz.Object.ListCount - 1
                If ctlz.Object.Selected(iZ) Then
                    .PivotItems(ctlz.Object.List(iZ)).Visible = True
                End If
            Next
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields(attrib)
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Count"), "Sum of Count", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Count")
        .Calculation = xlPercentOfColumn
        .NumberFormat = "0.00%"
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields(attrib)
        .Orientation = xlRowField
        .Position = 1
    End With
 
    chartrow = Application.CountA(Range("C7:C1000000")) + 6
    ActiveSheet.PivotTables("PivotTable1").RowGrand = False
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
    cnum = ws_comp_chart.Range("A6").CurrentRegion.Columns.Count + 1
    Cells(6, cnum).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
    Calculate
    Cells(6, cnum).Select
    Selection.AutoFill Destination:=Range(Cells(6, cnum), Cells(chartrow - 1, cnum))
 
    ws_comp_chart.Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    ws_comp.Activate
    ActiveSheet.ChartObjects("Chart 25").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).XValues = "='Comparison Analysis Data'!$A$6:$A$" & chartrow - 1
    ActiveChart.SeriesCollection(1).Values = "='Comparison Analysis Data'!$B$6:$B$" & chartrow - 1
    ActiveChart.SeriesCollection(2).Values = "='Comparison Analysis Data'!$C$6:$C$" & chartrow - 1
    ActiveChart.SeriesCollection(1).Name = "='Comparison Analysis Data'!$B$5"
    ActiveChart.SeriesCollection(2).Name = "='Comparison Analysis Data'!$C$5"
    ActiveSheet.ChartObjects(1).Chart. _
    ChartTitle.Characters.Text = "Percentage of " & brand & Chr(13) _
    & " within " & caption & " - " & foundation & " by " & attrib
 
    Sheets("Comparison Analysis Data").Visible = False
    ws_comp.Activate
    Range("A1").Select
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
I can't see which part of this creates data for all the chosen categories. Does it only create data for 2 series always? You wanted to know how to add extra series to the chart ... but I don't see that the data will actually exist. Can you point me to how the chosen categories are transformed into data?

Is the number of series related to the cnum variable maybe?
So could you loop using that as a loop control ( For ...... To cnum )?


An idea ... does this work:
Code: 
    ws_comp.Activate
    ActiveSheet.ChartObjects("Chart 25").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).XValues = "='Comparison Analysis Data'!$A$6:$A$" & chartrow - 1
    For indexser = 1 To cnum
        straddress = Range("A6:A" & chartrow - 1).Offset(0, indexser).Address
        strnamadd = Range("A6").Offset(0, indexser).Address
        ActiveChart.SeriesCollection(indexser).Values = "='Comparison Analysis Data'!" & straddress
        ActiveChart.SeriesCollection(indexser).Name = "='Comparison Analysis Data'!" & strnamadd
    Next
    ActiveSheet.ChartObjects(1).Chart. _
    ChartTitle.Characters.Text = "Percentage of " & brand & Chr(13) _
    & " within " & caption & " - " & foundation & " by " & attrib
... replace current series creation code with this.
 
Last edited:
Upvote 0
Thanks Glenn! It seems to work great when there are only two selected...when I select three it tells me invalid parameter...here is the code that I am using...

Code: 
cnum = ws_comp_chart.Range("A6").CurrentRegion.Columns.Count - 1
 
ws_comp_chart.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
ws_comp.Activate
ActiveSheet.ChartObjects("Chart 25").Activate
ActiveChart.PlotArea.Select
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).XValues = "='Comparison Analysis Data'!$A$6:$A$" & chartrow - 1
For indexser = 1 To cnum
straddress = Range("A6:A" & chartrow - 1).Offset(0, indexser).Address
strnamadd = Range("A5").Offset(0, indexser).Address
ActiveChart.SeriesCollection(indexser).Values = "='Comparison Analysis Data'!" & straddress
ActiveChart.SeriesCollection(indexser).Name = "='Comparison Analysis Data'!" & strnamadd
Next
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA Chart Series title with multiple cells
Replies
4
Views
135
mikejvir
M
B
  • Question Question
Retain Chart Formatting when change series references
Replies
2
Views
310
Jon Peltier
J
M
  • Question Question
Changing of Chart's Column Data Series Conveniently
Replies
2
Views
125
mangocat123
M
L
  • Locked
  • Question Question
How set range for chart in powerpoint created from vba
Replies
0
Views
117
Legacy 519704
L
F
  • Question Question
Macro to change colour on selected series on active chart
Replies
1
Views
492
Domenic
D

Forum statistics

Threads
1,224,587
Messages
6,179,735
Members
452,939
Latest member
WCrawford

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top