M
mtonkovich
Dear NGs,
Many have been gracious with their time and have helped me build this
work of art which creates 88 different chartsheets. Today, I tried to
expand on it by adding a second y-axis and it crashed.
This was the offending line - the line I added. Incidentally, I used
the Macro recorder to generate the code.
..SeriesCollection(2).AxisGroup = 2
If you scroll down, you'll see where I tried adding it. I've indicated
its insertion point with "&&&&&&&&&&&&&"
The line that it crashes on, or at least the line that is highlighted
in yellow (which I guess means that it was the line above it the threw
the error, right?) is marked by **********
I've included a small data set at the bottom.
I would really appreciate any help on this. I'm at a loss here.
Mike
Sub GraphByUniqueCategory()
Application.ScreenUpdating = False
Dim myList() As Variant
Dim i As Integer
Dim j As Integer
Dim myCount As Integer
Dim chtDeer As Chart
Dim shtData As Worksheet
Dim rngData As Range
Dim myDataSet As Range
Dim strCounty As String
myCount = 1
Set shtData = Worksheets("Sheet1")
With shtData.Range("A2").CurrentRegion.Columns(1)
..AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ReDim myList(1 To .SpecialCells(xlCellTypeVisible).Count)
'MsgBox .SpecialCells(xlCellTypeVisible).Count
With .SpecialCells(xlCellTypeVisible)
For j = 1 To .Areas.Count
'MsgBox "There are " & .Areas.Count & " Areas"
'MsgBox "This is J " & .Areas(j).Address
For i = 1 To .Areas(j).Cells.Count
myList(myCount) = .Areas(j).Cells(i).Value
'MsgBox "This is CellsI " & .Areas(j).Cells(i).Value
'MsgBox myList(myCount)
myCount = myCount + 1
Next i
Next j
End With
*************ActiveSheet.ShowAllData*********
End With
Set myDataSet = shtData.Range("b2").CurrentRegion
'note that there is nothing significant about b2, the address of
the currrent
'region remains the same as long the cell in the range address is
somewhere in
'the first 67 rows and 3 columns
'MsgBox "This is the range address for mydataset " &
shtData.Range("b2").CurrentRegion.Address
For i = LBound(myList) + 1 To UBound(myList)
'MsgBox "Now doing " & myList(i) & " County"
shtData.Range("A2").AutoFilter Field:=1, Criteria1:=myList(i)
'This example filters a list starting in cell A1 on Sheet1 to
display only the
'entries in which field one is equal to the current value in the
array myList.
Set rngData = Intersect(myDataSet,
shtData.Range("c:E").SpecialCells(xlCellTypeVisible))
'MsgBox "This is the range address for rngData " & rngData.Address
strCounty = Trim(shtData.Range("A65536").End(xlUp).Value)
' make a chart
Set chtDeer = Charts.Add
With chtDeer
.ChartType = xlLineMarkers
.SetSourceData Source:=rngData, PlotBy:=xlColumns
.SeriesCollection(1).XValues = "=Sheet1!R2C2:R12C2"
&&&&&&&&&&&&&&
.Location Where:=xlLocationAsNewSheet
.HasTitle = True
.HasDataTable = True
.DataTable.ShowLegendKey = False
With .ChartTitle
.Characters.Text = strCounty & " County" & vbCr & " Antlered Buck
Gun Harvest, 1995-present"
.Characters(Start:=1, Length:=7 + Len(strCounty)).Font.Size = 18
.Characters(Start:=8 + Len(strCounty), Length:=80).Font.Size = 14
End With
.Axes(xlCategory).HasTitle = True
With .Axes(xlCategory).AxisTitle
.Characters.Text = "Year"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 14
End With
'With .Axes(xlCategory).TickLabels
' .Font.Name = "Arial"
' .Font.Bold = False
' .Font.Size = 12
'End With
.Axes(xlValue).HasTitle = True
With .Axes(xlValue).AxisTitle
.Characters.Text = "Number of bucks"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 14
End With
With .Axes(xlValue).TickLabels
.Font.Name = "Arial"
.Font.Bold = False
.Font.Size = 12
End With
.HasLegend = False
'With .Legend
' Position = xlBottom
' .Border.LineStyle = xlNone
' .Font.Name = "arial"
' .Font.Size = 12
'End With
With .PlotArea
.Interior.ColorIndex = xlNone
With .Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
..Name = strCounty & " County"
End With
Next i
shtData.ShowAllData
Application.ScreenUpdating = True
End Sub
CNTY Year Antlerless Regulation
Adams 1995 1068 18
Adams 1996 989 18
Adams 1997 804 15
Adams 1998 451 11
Adams 1999 375 9
Adams 2000 493 12
Adams 2001 818 16
Adams 2002 1144 16
Adams 2003 1062 16
Adams 2004 1180 16
Adams 2005 1567 19
Many have been gracious with their time and have helped me build this
work of art which creates 88 different chartsheets. Today, I tried to
expand on it by adding a second y-axis and it crashed.
This was the offending line - the line I added. Incidentally, I used
the Macro recorder to generate the code.
..SeriesCollection(2).AxisGroup = 2
If you scroll down, you'll see where I tried adding it. I've indicated
its insertion point with "&&&&&&&&&&&&&"
The line that it crashes on, or at least the line that is highlighted
in yellow (which I guess means that it was the line above it the threw
the error, right?) is marked by **********
I've included a small data set at the bottom.
I would really appreciate any help on this. I'm at a loss here.
Mike
Sub GraphByUniqueCategory()
Application.ScreenUpdating = False
Dim myList() As Variant
Dim i As Integer
Dim j As Integer
Dim myCount As Integer
Dim chtDeer As Chart
Dim shtData As Worksheet
Dim rngData As Range
Dim myDataSet As Range
Dim strCounty As String
myCount = 1
Set shtData = Worksheets("Sheet1")
With shtData.Range("A2").CurrentRegion.Columns(1)
..AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ReDim myList(1 To .SpecialCells(xlCellTypeVisible).Count)
'MsgBox .SpecialCells(xlCellTypeVisible).Count
With .SpecialCells(xlCellTypeVisible)
For j = 1 To .Areas.Count
'MsgBox "There are " & .Areas.Count & " Areas"
'MsgBox "This is J " & .Areas(j).Address
For i = 1 To .Areas(j).Cells.Count
myList(myCount) = .Areas(j).Cells(i).Value
'MsgBox "This is CellsI " & .Areas(j).Cells(i).Value
'MsgBox myList(myCount)
myCount = myCount + 1
Next i
Next j
End With
*************ActiveSheet.ShowAllData*********
End With
Set myDataSet = shtData.Range("b2").CurrentRegion
'note that there is nothing significant about b2, the address of
the currrent
'region remains the same as long the cell in the range address is
somewhere in
'the first 67 rows and 3 columns
'MsgBox "This is the range address for mydataset " &
shtData.Range("b2").CurrentRegion.Address
For i = LBound(myList) + 1 To UBound(myList)
'MsgBox "Now doing " & myList(i) & " County"
shtData.Range("A2").AutoFilter Field:=1, Criteria1:=myList(i)
'This example filters a list starting in cell A1 on Sheet1 to
display only the
'entries in which field one is equal to the current value in the
array myList.
Set rngData = Intersect(myDataSet,
shtData.Range("c:E").SpecialCells(xlCellTypeVisible))
'MsgBox "This is the range address for rngData " & rngData.Address
strCounty = Trim(shtData.Range("A65536").End(xlUp).Value)
' make a chart
Set chtDeer = Charts.Add
With chtDeer
.ChartType = xlLineMarkers
.SetSourceData Source:=rngData, PlotBy:=xlColumns
.SeriesCollection(1).XValues = "=Sheet1!R2C2:R12C2"
&&&&&&&&&&&&&&
.Location Where:=xlLocationAsNewSheet
.HasTitle = True
.HasDataTable = True
.DataTable.ShowLegendKey = False
With .ChartTitle
.Characters.Text = strCounty & " County" & vbCr & " Antlered Buck
Gun Harvest, 1995-present"
.Characters(Start:=1, Length:=7 + Len(strCounty)).Font.Size = 18
.Characters(Start:=8 + Len(strCounty), Length:=80).Font.Size = 14
End With
.Axes(xlCategory).HasTitle = True
With .Axes(xlCategory).AxisTitle
.Characters.Text = "Year"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 14
End With
'With .Axes(xlCategory).TickLabels
' .Font.Name = "Arial"
' .Font.Bold = False
' .Font.Size = 12
'End With
.Axes(xlValue).HasTitle = True
With .Axes(xlValue).AxisTitle
.Characters.Text = "Number of bucks"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 14
End With
With .Axes(xlValue).TickLabels
.Font.Name = "Arial"
.Font.Bold = False
.Font.Size = 12
End With
.HasLegend = False
'With .Legend
' Position = xlBottom
' .Border.LineStyle = xlNone
' .Font.Name = "arial"
' .Font.Size = 12
'End With
With .PlotArea
.Interior.ColorIndex = xlNone
With .Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
..Name = strCounty & " County"
End With
Next i
shtData.ShowAllData
Application.ScreenUpdating = True
End Sub
CNTY Year Antlerless Regulation
Adams 1995 1068 18
Adams 1996 989 18
Adams 1997 804 15
Adams 1998 451 11
Adams 1999 375 9
Adams 2000 493 12
Adams 2001 818 16
Adams 2002 1144 16
Adams 2003 1062 16
Adams 2004 1180 16
Adams 2005 1567 19