excelvbagraph

How to add every 8th column to a graph in Excel VBA


I am stuck on how to add only every 8th column of data starting from column Z. The range should always be from row 27 to 194.

This is the code I currently have for creating the graph. I want to replace the manual range (Z$27:Z$194,AH$27:AH$194,...) with something other because I have a lot of columns.

Thanks in advance for any help!

Sub Graph_VBA()
Cells(713, 1).Select
ActiveSheet.Shapes.AddChart2(227, xlLineMarkersStacked100).Select
ActiveChart.SetSourceData Source:=Range("Z$27:Z$194,AH$27:AH$194,AP$27:AP$194,AX$27:AX$194,BF$27:BN$194,BF$27:BN$194")
ActiveChart.ChartTitle.Text = "Winter"
ActiveChart.ChartArea.Height = 400
ActiveChart.ChartArea.Width = 750
ActiveChart.Parent.Cut
Cells(713, 1).PasteSpecial
End Sub

enter image description here


Solution

  • First, let's try not to use Select:

    Sub Graph_VBA()
        Dim shp AS Shape, cht AS Chart
        Set shp = ActiveSheet.Shapes.AddChart2(227, xlLineMarkersStacked100)
        Set cht = shp.Chart
        cht.SetSourceData Source:=Range("Z$27:Z$194,AH$27:AH$194,AP$27:AP$194,AX$27:AX$194,BF$27:BN$194,BF$27:BN$194")
        cht.ChartTitle.Text = "Winter"
        cht.ChartArea.Height = 400
        cht.ChartArea.Width = 750
        shp.Top = ActiveSheet.Cells(713, 1).Top
        shp.Left = ActiveSheet.Cells(713, 1).Left
    End Sub
    

    Next, let's use the SeriesCollection object (and, more specifically, the SeriesCollection.Add method) to add our columns one-by-one with a loop, instead of all at once:

    Sub Graph_VBA()
        Dim shp AS Shape, cht AS Chart, i as Long, col AS Long, rng AS Range
        Set shp = ActiveSheet.Shapes.AddChart2(227, xlLineMarkersStacked100)
        Set cht = shp.Chart
        
        For i = 1 to 6 'Add 6 columns
            col = 26 + ((i-1)*8) 'Every 8th column, starting at Z (26)
            Set rng = ActiveSheet.Range(ActiveSheet.Cells(27, col), _
                ActiveSheet.Cells(194, col)) 'Rows 27 to 194
            'Add "Rng", as a Data Column, with a Header in the first row, and Replace existing data
            cht.SeriesCollection.Add rng, xlColumns, True, True
        Next i
        
        cht.ChartTitle.Text = "Winter"
        cht.ChartArea.Height = 400
        cht.ChartArea.Width = 750
        shp.Top = ActiveSheet.Cells(713, 1).Top
        shp.Left = ActiveSheet.Cells(713, 1).Left
    End Sub