JimS
03-25-2010, 11:18 AM
Below is some VBA that automatically creates a Chart for every sheet name that is on the Worksheet labeled CList (starting with Cell A4 and continuing down Column A for as many sheet names that are in the list.
This code works perfectly for one exception.
It fails with a “Run-time Error 9 / Subscript out of Range” error if there is only 1 sheet name on the CList (data only in Cell A4 and nothing below it) at this line:
Set WS = ThisWorkbook.Worksheets(NameCell.Value)
Any ideas as to why this is happening?
Thanks for any and all help…
JimS
Sub PlotCharts()
Dim NameRange As Range, NameCell As Range
Dim ChartRange As Range, BaseRange As Range, i As Long
Dim CH As Chart
Dim WS As Worksheet
Application.ScreenUpdating = False
Set NameRange = ThisWorkbook.Worksheets("CList").Range("A4")
Set NameRange = Range(NameRange, NameRange.End(xlDown))
For Each NameCell In NameRange.Cells
Set WS = ThisWorkbook.Worksheets(NameCell.Value)
i = 1
Set BaseRange = WS.Range("A5", WS.Range("A" & WS.Rows.Count).End(xlUp))
Set ChartRange = BaseRange
Do
If WS.Range("A5").Offset(, i * 6 - 4).Value = "" Then Exit Do
Set ChartRange = Union(ChartRange, BaseRange.Offset(, i * 6 - 4).Resize(, 2))
i = i + 1
Loop While i < 43
Set CH = ThisWorkbook.Charts.Add
With CH
.ChartType = xlColumnClustered
.SetSourceData Source:=ChartRange, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet, Name:=WS.Name & " Chart"
.PlotArea.Interior.ColorIndex = 2
.PlotArea.Width = CH.ChartArea.Width - 15
With .Legend
.Top = 10
.Left = CH.Axes(xlValue).Left + 10
.Height = (i - 1) * 24
.Width = 300
.Shadow = False
.Interior.ColorIndex = xlNone
.Border.LineStyle = x1None
End With
End With
ActiveChart.Deselect
Next
Application.ScreenUpdating = True
End Sub
This code works perfectly for one exception.
It fails with a “Run-time Error 9 / Subscript out of Range” error if there is only 1 sheet name on the CList (data only in Cell A4 and nothing below it) at this line:
Set WS = ThisWorkbook.Worksheets(NameCell.Value)
Any ideas as to why this is happening?
Thanks for any and all help…
JimS
Sub PlotCharts()
Dim NameRange As Range, NameCell As Range
Dim ChartRange As Range, BaseRange As Range, i As Long
Dim CH As Chart
Dim WS As Worksheet
Application.ScreenUpdating = False
Set NameRange = ThisWorkbook.Worksheets("CList").Range("A4")
Set NameRange = Range(NameRange, NameRange.End(xlDown))
For Each NameCell In NameRange.Cells
Set WS = ThisWorkbook.Worksheets(NameCell.Value)
i = 1
Set BaseRange = WS.Range("A5", WS.Range("A" & WS.Rows.Count).End(xlUp))
Set ChartRange = BaseRange
Do
If WS.Range("A5").Offset(, i * 6 - 4).Value = "" Then Exit Do
Set ChartRange = Union(ChartRange, BaseRange.Offset(, i * 6 - 4).Resize(, 2))
i = i + 1
Loop While i < 43
Set CH = ThisWorkbook.Charts.Add
With CH
.ChartType = xlColumnClustered
.SetSourceData Source:=ChartRange, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet, Name:=WS.Name & " Chart"
.PlotArea.Interior.ColorIndex = 2
.PlotArea.Width = CH.ChartArea.Width - 15
With .Legend
.Top = 10
.Left = CH.Axes(xlValue).Left + 10
.Height = (i - 1) * 24
.Width = 300
.Shadow = False
.Interior.ColorIndex = xlNone
.Border.LineStyle = x1None
End With
End With
ActiveChart.Deselect
Next
Application.ScreenUpdating = True
End Sub