Loop to create charts

[Lance Hoffmeyer]

Hey all,

I have about 50 columns of data and need to create a chart for each column. Currently
I am writing separate macro for each column. The only thing that really changes is the
chart name, source data range, and series collection name. How can I write a loop to create
a chart for each column of data?

Thanks in advance

Lance


For i = 2 to 50
Charts.Add
ActiveChart.ChartType = xlBarClustered
ActiveChart.Location Where:=xlLocationAsNewSheet
'
'''
''' Not certain how to change this for a loop - this gives an error
ActiveChart.SetSourceData Source:=Sheets("Data").Range("Cells(2,i),Cells(13,i)), PlotBy:=xlColumns
'''
''' Not certain how to change this for a loop
ActiveChart.SeriesCollection(1).Name = "=Data!R1C3"

'
ActiveChart.SeriesCollection(1).XValues = "=Data!R2C1:R13C1"
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels ShowValue:=True
ActiveChart.Deselect
Sheets(iCName).Move After:=Worksheets(Worksheets.Count)
Next i



Sub S1B2()
iCName = "S1B2"
Charts.Add
ActiveChart.ChartType = xlBarClustered
ActiveChart.Location Where:=xlLocationAsNewSheet
'
ActiveChart.SetSourceData Source:=Sheets("Data").Range("C2:C13"), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Name = "=Data!R1C3"
ActiveChart.Name = iCName
'
ActiveChart.SeriesCollection(1).XValues = "=Data!R2C1:R13C1"
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels ShowValue:=True
ActiveChart.Deselect
Sheets(iCName).Move After:=Worksheets(Worksheets.Count)
End Sub
Sub S1B3()
iCName = "S1B3"
Charts.Add
ActiveChart.ChartType = xlBarClustered
ActiveChart.Location Where:=xlLocationAsNewSheet
'
ActiveChart.SetSourceData Source:=Sheets("Data").Range("D213"), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Name = "=Data!R1C4"
ActiveChart.Name = iCName
'
ActiveChart.SeriesCollection(1).XValues = "=Data!R2C1:R13C1"
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels ShowValue:=True
ActiveChart.Deselect
Sheets(iCName).Select
Sheets(iCName).Move After:=Sheets(Sheets.Count)
End Sub

 

[Dave Peterson]

Maybe this will help:

Option Explicit
Sub testme()
Dim i As Long
Dim SourceRng As Range
Dim XVRng As Range

For i = 2 To 50
Charts.Add
ActiveChart.ChartType = xlBarClustered
ActiveChart.Location Where:=xlLocationAsNewSheet

With Worksheets("data")
Set SourceRng = .Range(.Cells(2, i), .Cells(13, i))
Set XVRng = .Range(.Cells(2, 1), .Cells(13, 1))
End With

ActiveChart.SetSourceData Source:=SourceRng, PlotBy:=xlColumns

ActiveChart.SeriesCollection(1).Name _
= Worksheets("data").Cells(1, i + 1).Value

ActiveChart.SeriesCollection(1).XValues = XVRng
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels ShowValue:=True
ActiveChart.Deselect
'Sheets(iCName).Move After:=Worksheets(Worksheets.Count)
Next i

End Sub