Bernie -
Hey - I've been working on modifying the code that you wrote for me and
I've made a little progress (with some help from others and a thought
of tinkering, I've added a two line title and a couple of other things
- inefficiently added axes lables and moved the legend around). My
problem now is that I've tried to modify the chart type - from simple
XY line to a custom chart type that will allow me to plot on both the
y1 and y2 axis. I've figured out the code that changes it, but when I
add it, the year gets plotted as a series along with the other two
series and of course, now there are no x-axis labels. I can't figure
out what code is controlling the series and the x-axis labels.
I know I'm asking a lot, but I'm at a loss. Could you help me sort
this out?
Mike
The code that follows is where I'm out now.
When I add the following line - it goes to heck - ' .ApplyCustomType
ChartType:=xlBuiltIn, TypeName:= _
"Lines on 2 Axes"
Sub GraphByUniqueCategory()
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)
With .SpecialCells(xlCellTypeVisible)
For j = 1 To .Areas.Count
For i = 1 To .Areas(j).Cells.Count
myList(myCount) = .Areas(j).Cells(i).Value
myCount = myCount + 1
Next i
Next j
End With
ActiveSheet.ShowAllData
End With
Set myDataSet = shtData.Range("B2").CurrentRegion
For i = LBound(myList) + 1 To UBound(myList)
'MsgBox "Now doing " & myList(i)
shtData.Range("A2").AutoFilter Field:=1, Criteria1:=myList(i)
Set rngData = Intersect(myDataSet,
shtData.Range("B:E").SpecialCells(xlCellTypeVisible))
strCounty = shtData.Range("A65536").End(xlUp).Value
' make a chart
Set chtDeer = Charts.Add
With chtDeer
'ActiveSheet.ChartObjects.Activate
.ChartType = xlXYScatterLines
' .ApplyCustomType ChartType:=xlBuiltIn, TypeName:= _
"Lines on 2 Axes"
.SetSourceData Source:=rngData, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasTitle = True
.ChartTitle.Characters.Text = strCounty & " County" & vbCr & "
Accounting-style and Lang & Wood w Downing Population Estimates,
1981-present"
ActiveChart.ChartTitle.Select
Selection.Characters(Start:=1, Length:=7 + Len(strCounty)).Font.Size
= 18
Selection.Characters(Start:=8 + Len(strCounty),
Length:=60).Font.Size = 12
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Year"
.Axes(xlCategory).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Population
estimate"
.Axes(xlValue).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
.HasLegend = True
.Name = strCounty & " County"
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.Legend.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
Selection.Shadow = False
Selection.Interior.ColorIndex = xlAutomatic
Next i
shtData.ShowAllData
End Sub
