Creating Multiple Charts using VBA

Question

I'm trying to create multiple charts (i.e. different chart objects with one graph on each). I found a code on youtube that is linked in the comment that I'm modifying.

For now I want to be able to give StartRow which is a starting point and create a scatter plot of the next 700 rows. Then move to another column and plot that.

The code below does indeed create two chart objects but it is:

Creating multiple graphs on each chart object.
Selecting the data starting from Row 1 (instead of Row 5)
Selects x and y values for each graph in the same column.
The two chart objects are duplicates.

Sub AddCharts()


'https://www.youtube.com/watch?v=5_p8hltGY4s

Dim StartRow as Integer
StartRow = 5

Dim j As Integer 'columns

For j = 5 To 7
    With Worksheets("CVData").Shapes.AddChart.Chart
   .ChartType = xlXYScatter
       
    '.ChartType = xlXYScatterPlot
    .SeriesCollection.NewSeries
       With .SeriesCollection(1)
       
        .XValues = "=" & ActiveSheet.Name & "!" & _
        Range(Cells(StartRow, 4), Cells(StartRow + 705, 4)).Address
        
        .Values = "=" & ActiveSheet.Name & "!" & _
        Range(Cells(StartRow, j), Cells(StartRow + 700, j)).Address
        End With
    .HasLegend = False
  End With
Next j

End Sub

The data has this form and I want to create scatter plots of 700 entries of column D against E, K, H, and M:

user_9808063 · Answer

Try this procedure with little modification and note that array of columns is made to loop through and values addresses are changed accordingly.

Sub AddCharts()
'https://stackoverflow.com/questions/68437040/creating-multiple-charts-using-vba
'https://www.youtube.com/watch?v=5_p8hltGY4s
Dim StartRow As Integer
Dim j As Long 'columns
Dim ColArr 'Columns array
StartRow = 5

ColArr = Array("E", "K", "H", "M")
For j = 0 To UBound(ColArr)
    With Worksheets("CVData").Shapes.AddChart2(240, xlXYScatter).Chart
    .SeriesCollection.NewSeries
    .SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!" & _
        Range(Cells(StartRow, 4), Cells(StartRow + 700, 4)).Address
    .SeriesCollection(1).Values = "=" & ActiveSheet.Name & "!" & _
        Range(Cells(StartRow, ColArr(j)), Cells(StartRow + 700, ColArr(j))).Address
    .HasLegend = False
    End With
Next j

End Sub

EDIT as per comment below Check after replacing the with block above with the below. It takes series names from 4th row and removes extra series.

With Worksheets("CVData").Shapes.AddChart2(240, xlXYScatter).Chart
    .SetSourceData Source:=Range( _
        "CVData!" & _
            Range(Cells(StartRow, 4), _
            Cells(StartRow + 700, 4)).Address & _
        "," & _
        "CVData!" & _
            Range(Cells(StartRow, ColArr(j)), _
            Cells(StartRow + 700, ColArr(j))).Address)
    .FullSeriesCollection(1).Name = "=CVData!" & _
        Worksheets("CVData").Cells(StartRow - 1, ColArr(j)).Address
    .HasLegend = False
End With

Creating Multiple Charts using VBA

1 Answers