Excel VBA Script to dynamically add series to chart

Question

I'm trying to dynamically add multiple series to a line chart. I don't know beforehand how many series there are so it needs to be dynamic. What I've come up with but doesn't work is the following:

The sheet ActiveSheet (or Sheets("Data")) has Rows from C14 until Cend containing the XValues and Columns from E14:Eend until R14:Rend where "end" marks the last row of data as determined by column C. The series names are stored in row 9. XValues are the same for all series.

My big problem is, that I can't find a way to dynamically add all the data columns as series to my chart together with the respective name. I'm not an expert in VBA so please be kind. I already read various sources and tried many scripts, none seem to work. The Object Catalogue was a bit of a help, however my problem persists.

Sub MakeChart()
Dim LastColumn As Long
Dim LastRow As Long
Dim i As Integer
Dim u As Integer
Dim NameRng As String
Dim CountsRng As Range
Dim xRng As Range

    LastColumn = ActiveSheet.Cells(8, Columns.Count).End(xlToLeft).Column
    ColumnCount = LastColumn - 4
    LastRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
'   Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & " LastRow: " & LastRow)

    Charts.Add
    With ActiveChart
        .ChartType = xlLineMarkers
        .HasTitle = True
        .ChartTitle.Text = "Test"
    End With

    For i = 1 To ColumnCount
        u = i + 4
       NameRng = Sheets("Data").Range("R9:C" & u).Value
       Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3")
       Set CountsRng = Sheets("Data").Range("R14:C" & u, "R" & LastRow & ":C" & u)
'      Debug.Print ("CountsRng: R14:C" & u & ", R" & LastRow & ":C" & u & " NameRng: " & NameRng & " xRng: R14:C3 , R" & LastRow & ":C3")
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(i).XValues = xRng
            ActiveChart.SeriesCollection(i).Values = CountsRng
            ActiveChart.SeriesCollection(i).Name = NameRng
    Next i

End Sub

Diabolize

Up to where does it work, from which point does it not work? – Angel

Does the series perhaps start with series 0? thus SeriesCollection(i-1)? If I am not mistaken you could also use With ActiveChart.SeriesCollection.NewSeries and set the .XValues etc in the following lines. Then close with End With – Angel

Answer 1

thanks for the help. I solved the problem. It seems as I have somehow completely messed up the notation of the cell range. You cannot use

Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3")

But rather have to use

Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3))

Also, the use of Charts.Add didnt help very much as Excel tries to automatically find the correct ranges for all series and adds them resulting in a completely messed up chart. A better way was to use

Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500)

As this will create a completely empty graph to which you can add your own series

Here is the complete and working code for anyone interested:

Sub MakeChart()
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim ColumnCount As Long
    LastRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
    LastColumn = ActiveSheet.Cells(8, Columns.Count).End(xlToLeft).Column
    ColumnCount = LastColumn - 4
    Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & " LastRow: " & LastRow)

    Dim wsChart As Worksheet
    Set wsChart = Sheets(1)
    wsChart.Activate
    Dim ChartObj As ChartObject
    Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500)
    ChartObj.chart.ChartType = xlLineMarkers

    Dim i As Integer
    Dim u As Integer
    Dim NameRng As String
    Dim xRng As Range
    Dim CountsRng As Range

    For i = 1 To ColumnCount
        u = i + 4

        With Sheets("Data")
            NameRng = .Cells(9, u).Value
            Set CountsRng = .Range(.Cells(14, u), .Cells(LastRow, u))
            Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3))
            Debug.Print "--" & i & "--" & u & "--"
            Debug.Print "x Range: " & xRng.Address
            Debug.Print "Name Range: " & .Cells(9, u).Address
            Debug.Print "Value Range: " & CountsRng.Address
        End With

        'Set ChartSeries = ChartObj.chart.SeriesCollection.NewSeries
        'With ActiveChart.SeriesCollection.NewSeries
        With ChartObj.chart.SeriesCollection.NewSeries
            .XValues = xRng
            .Values = CountsRng
            .Name = NameRng
        End With
        'Set xRng = Nothing
        'Set CountsRng = Nothing
        'NameRng = ""
    Next i

    'ChartObj.Activate
    With ChartObj.chart
        .SetElement (msoElementLegendBottom)
        .Axes(xlValue).MajorUnit = 1
        .Axes(xlValue).MinorUnit = 0.5
        .Axes(xlValue).MinorTickMark = xlOutside
        '.Axes(xlCategory).TickLabels.NumberFormat = "#,##000"
        .Axes(xlCategory).TickLabels.NumberFormat = "#,##0"
        '.Location Where:=xlLocationAsObject, Name:="Plot"
    End With

End Sub

Diabolize

Answer 2

sample code

Sub InsertChart()

    Dim first As Long, last As Long
    first = 10
    last = 20

    Dim wsChart As Worksheet
    Set wsChart = Sheets(1)

    wsChart.Activate
    wsChart.Shapes.AddChart.Select

    Dim chart As chart
    Set chart = ActiveChart
    chart.ChartType = xlXYScatter

    ' adding series
    chart.SeriesCollection.NewSeries
    chart.SeriesCollection(1).Name = "series name"
    chart.SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!$A$" & first & ":$A$" & last
    chart.SeriesCollection(1).Values = "=" & ActiveSheet.Name & "!$B$" & first & ":$B$" & last

End Sub

you can iterate over range and keep adding more series

Lockard