how loop plots in excel vba macro

Question

I am trying loop the scatter plot over columns using Excel VBA, but did get idea how to do it.

Here is a dummy data I produced by filling Y series with RAND() function and the figure shows a sample chart I produced.

Here is associated codes:

Sub multichart()
    Range("A1:B21").Select
    Charts.Add
    ActiveChart.ChartType = xlXYScatter
    ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1:B21"), PlotBy _
        :=xlColumns
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Y1"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
    End With
    ActiveSheet.Shapes("Chart 6").ScaleHeight 0.61, msoFalse, msoScaleFromTopLeft
    ActiveChart.PlotArea.Select
    Selection.Top = 1
    Selection.Height = 106
    Selection.Height = 113
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With
End Sub

I want to loop this process to create N graphs (where N is number of Y columns in any sheet), means vary from sheet to sheet. Also plots will be appended one after another. Y limits and X limit are intended to be same in all plots for comparison. The output look something like (just showing 4 variables for example):

Sorry if this a basic question as I am Excel VBA guest.

Answer 1

You don't say what version of Excel. This works in 2010 and I think should work in other version. But I'm not a VBA chart expert. Hopefully the variable names are self-explanatory:

Sub multichart()
Dim ws As Excel.Worksheet
Dim i As Long
Dim cht As Chart
Dim cho As ChartObject
Dim TitleRange As Excel.Range
Dim DataRange As Excel.Range
Dim ChartHeight As Long
Dim LastCol As Long
Dim LastRow As Long
Dim MaxAmountToChart

Set ws = ActiveSheet
'delete the old ones
For Each cho In ws.ChartObjects
    cho.Delete
Next
ChartHeight = 20
With ws
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    MaxAmountToChart = Application.WorksheetFunction.Max(ws.Range(ws.Cells(1, 2), .Cells(LastRow, LastCol)))
    Set TitleRange = .Range("A1:A" & LastRow)
    For i = 2 To LastCol
        Set DataRange = .Range(.Cells(1, i), .Cells(LastRow, i))
        Set cht = Charts.Add
        cht.Location Where:=xlLocationAsObject, Name:=.Name
        Set cho = .ChartObjects(.ChartObjects.Count)
        cho.Top = (i - 1) * ChartHeight * .Rows(1).RowHeight
        cho.Left = 0
        Set cht = cho.Chart
        '.Shapes(cht.Name).ScaleHeight 0.61, msoFalse, msoScaleFromTopLeft
        With cht
            .ChartType = xlXYScatter
            .SetSourceData Source:=Union(TitleRange, DataRange), PlotBy:=xlColumns
            .HasTitle = True
            .ChartTitle.Characters.Text = "Y1"
            .Axes(xlCategory, xlPrimary).HasTitle = False
            .Axes(xlValue, xlPrimary).MaximumScale = MaxAmountToChart
            With .PlotArea
                .Top = 1
                .Height = 106
                .Height = 113
                With .Border
                    .ColorIndex = 16
                    .Weight = xlThin
                    .LineStyle = xlContinuous
                End With
                With .Interior
                    .ColorIndex = 2
                    .PatternColorIndex = 1
                    .Pattern = xlSolid
                End With
            End With
        End With
    Next i
End With
End Sub