krixen
Member level 2
- Joined
- Jul 18, 2011
- Messages
- 43
- Helped
- 4
- Reputation
- 8
- Reaction score
- 4
- Trophy points
- 1,288
- Location
- Hauppauge, NY
- Activity points
- 1,648
I have created a program to graph data with the primary and secondary y axes and for some reason i cannot get the secondary y axis to show its corresponding title, whereas the primary title works just find. I found that the technique i am using works well with excel 2003 but in 2007 microsoft changed a few techniques and now you have to do it another way but i cannot find it. Any assistance will be much appreciated :] here is my code:
Public Function MakeAGraph( _
ByVal grphName As String, _
ByVal Xaxis As String, _
ByVal Yaxis As String, _
ByVal Y2axis As String, _
ByVal title As String, _
ByRef isChecked() As Boolean, _
ByVal tabNameExtension As String _
) As String
Dim ShtOpt As Worksheet
Set ShtOpt = Sheets("Option")
Dim cht As Chart
Set cht = Nothing
Dim shtCellList As Worksheet
Set shtCellList = Sheets("Color")
Dim rngX As Range
Dim rngY As Range
Dim rngy2 As Range
Dim colX As String
Dim colY As String
Dim ColY2 As String
Set rngX = ShtOpt.Range("A3:A30").Find(Xaxis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngX Is Nothing) Then
MakeAGraph = "Can't find X-axis: " + Xaxis
Exit Function
End If
colX = rngX.Offset(0, 1)
Dim xAxisTitle As String
xAxisTitle = rngX.Offset(0, 2)
Set rngY = ShtOpt.Range("A3:A30").Find(Yaxis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngY Is Nothing) Then
MakeAGraph = "Can't find Y-axis: " + Yaxis
Exit Function
End If
Set rngy2 = ShtOpt.Range("A3:A30").Find(Y2axis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngy2 Is Nothing) Then
'MakeAGraph = "Can't find Y2-axis: " + Y2axis
' Exit Function
End If
colY = rngY.Offset(0, 1)
Dim yAxisTitle As String
On Error Resume Next
yAxisTitle = rngY.Offset(0, 2)
On Error GoTo 0
If yAxisTitle = "" Then
'MakeAGraph = "Attempting to create graph: " + grphName + ", Can't find Y-axis title, looking up: " + Yaxis
'Exit Function
End If
If (rngy2 Is Nothing) Then
Else
ColY2 = rngy2.Offset(0, 1)
Dim YA2AxisTitle As String
On Error Resume Next
YA2AxisTitle = rngy2.Offset(0, 2)
On Error GoTo 0
If YA2AxisTitle = "" Then
'MakeAGraph = "Attempting to create graph: " + grphName + ", Can't find Y2-axis title, looking up: " + Y2axis
' Exit Function
End If
End If
Dim legalSheetName As String
legalSheetName = grphName
legalSheetName = Replace(legalSheetName, "[", "")
legalSheetName = Replace(legalSheetName, "]", "")
legalSheetName = Replace(legalSheetName, "*", "")
legalSheetName = Replace(legalSheetName, "?", "")
legalSheetName = Replace(legalSheetName, "/", "")
legalSheetName = Replace(legalSheetName, "\", "")
legalSheetName = Replace(legalSheetName, ".", "")
legalSheetName = Replace(legalSheetName, " ", "")
legalSheetName = Left(legalSheetName, 31)
For Each cht In ActiveWorkbook.Charts
If cht.Name = legalSheetName Then Exit For
Next cht
If (Not cht Is Nothing) Then
cht.Delete
End If
Charts.Add.Name = legalSheetName
Set cht = Charts(legalSheetName)
If (cht Is Nothing) Then
MakeAGraph = "Failed to create chart: " & grphName & " with legal sheet name: " & legalSheetName
Exit Function
End If
While (cht.SeriesCollection.Count > 0)
cht.SeriesCollection(1).Delete
Wend
cht.HasTitle = True
cht.ChartTitle.Text = title
cht.ChartTitle.Font.Size = 16
cht.ChartType = xlXYScatterLines
' X axis
Dim XA As Excel.Axis
Set XA = cht.Axes(xlCategory)
XA.HasMajorGridlines = True
XA.HasMinorGridlines = True
XA.HasTitle = True
XA.AxisTitle.Characters.Text = xAxisTitle
XA.AxisTitle.Font.Size = 14
XA.AxisTitle.Font.Color = vbRed
' Y axis
Dim YA As Excel.Axis
Set YA = cht.Axes(xlValue, xlPrimary)
YA.HasMajorGridlines = True
YA.HasMinorGridlines = True
YA.HasTitle = True
YA.AxisTitle.Characters.Text = YA2AxisTitle 'titles switched
YA.AxisTitle.Font.Size = 14
YA.AxisTitle.Font.Color = vbBlue
' Second Y Axis
Dim YA2 As Excel.Axis
Set YA2 = cht.Axes(xlValue, xlSecondary)
YA2.HasMajorGridlines = True
YA2.HasMinorGridlines = True
YA2.HasTitle = True
YA2.AxisTitle.Characters.Text = yAxisTitle 'titles switched
YA2.AxisTitle.Font.Size = 14
YA2.AxisTitle.Font.Color = vbBlue
' Legend
cht.Legend.Font.Size = 12
Dim lastRow As Long
Dim serXRange As String
Dim serYRange As String
Dim serY2Range As String
Dim seriesColor As Long
Dim serName As String
Dim serFormula As String
Dim fromSheetName As String
Dim ser As Series
Dim cell As Long
Dim shtInfo As Worksheet
Set shtInfo = Worksheets("Info")
For cell = 1 To NumberOfCells()
If (isChecked(cell)) Then
fromSheetName = CStr(cell) & tabNameExtension
If SheetExistsWithName(fromSheetName) Then
If (Sheets(fromSheetName).Range(EXISTING_DATA_CHECK) <> "") Then
lastRow = GetLastRowNumberFromColumnNamed(Sheets(fromSheetName), colX)
serXRange = "'" & fromSheetName & "'!" & colX & START_DATA_ROW & ":" & colX & lastRow
serYRange = "'" & fromSheetName & "'!" & colY & START_DATA_ROW & ":" & colY & lastRow
serName = shtInfo.Cells(cell + 4, 4) & "-1"
serFormula = "=SERIES(""" & serName & """," & serXRange & "," & serYRange & "," & cell & ")"
Set ser = cht.SeriesCollection.NewSeries
ser.Name = serName
ser.Formula = serFormula
seriesColor = shtCellList.Range("D2").Offset(cell, 0).Interior.Color
ser.Border.Color = seriesColor
ser.MarkerBackgroundColor = seriesColor
ser.MarkerForegroundColor = seriesColor
ser.MarkerSize = 2
ser.Format.Line.Weight = 0
If YA2AxisTitle = "" Then
Else
serName = shtInfo.Cells(cell + 4, 4) & "-2"
serY2Range = "'" & fromSheetName & "'!" & ColY2 & START_DATA_ROW & ":" & ColY2 & lastRow
serFormula = "=SERIES(""" & serName & """," & serXRange & "," & serY2Range & "," & fromSheetName & ")"
Set ser = cht.SeriesCollection.NewSeries
ser.Name = serName
ser.Formula = serFormula
ser.AxisGroup = xlSecondary
ser.Border.Color = seriesColor
ser.MarkerBackgroundColor = seriesColor
ser.MarkerForegroundColor = seriesColor
ser.MarkerSize = 2
ser.Format.Line.Weight = 0
End If
End If
End If
End If
Next cell
End Function
- - - Updated - - -
Also the line that is giving me an error is Set YA2 = cht.Axes(xlValue, xlSecondary), this line will work however if i get rid of xlValue and just leave the secondary inside the ( )
Public Function MakeAGraph( _
ByVal grphName As String, _
ByVal Xaxis As String, _
ByVal Yaxis As String, _
ByVal Y2axis As String, _
ByVal title As String, _
ByRef isChecked() As Boolean, _
ByVal tabNameExtension As String _
) As String
Dim ShtOpt As Worksheet
Set ShtOpt = Sheets("Option")
Dim cht As Chart
Set cht = Nothing
Dim shtCellList As Worksheet
Set shtCellList = Sheets("Color")
Dim rngX As Range
Dim rngY As Range
Dim rngy2 As Range
Dim colX As String
Dim colY As String
Dim ColY2 As String
Set rngX = ShtOpt.Range("A3:A30").Find(Xaxis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngX Is Nothing) Then
MakeAGraph = "Can't find X-axis: " + Xaxis
Exit Function
End If
colX = rngX.Offset(0, 1)
Dim xAxisTitle As String
xAxisTitle = rngX.Offset(0, 2)
Set rngY = ShtOpt.Range("A3:A30").Find(Yaxis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngY Is Nothing) Then
MakeAGraph = "Can't find Y-axis: " + Yaxis
Exit Function
End If
Set rngy2 = ShtOpt.Range("A3:A30").Find(Y2axis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngy2 Is Nothing) Then
'MakeAGraph = "Can't find Y2-axis: " + Y2axis
' Exit Function
End If
colY = rngY.Offset(0, 1)
Dim yAxisTitle As String
On Error Resume Next
yAxisTitle = rngY.Offset(0, 2)
On Error GoTo 0
If yAxisTitle = "" Then
'MakeAGraph = "Attempting to create graph: " + grphName + ", Can't find Y-axis title, looking up: " + Yaxis
'Exit Function
End If
If (rngy2 Is Nothing) Then
Else
ColY2 = rngy2.Offset(0, 1)
Dim YA2AxisTitle As String
On Error Resume Next
YA2AxisTitle = rngy2.Offset(0, 2)
On Error GoTo 0
If YA2AxisTitle = "" Then
'MakeAGraph = "Attempting to create graph: " + grphName + ", Can't find Y2-axis title, looking up: " + Y2axis
' Exit Function
End If
End If
Dim legalSheetName As String
legalSheetName = grphName
legalSheetName = Replace(legalSheetName, "[", "")
legalSheetName = Replace(legalSheetName, "]", "")
legalSheetName = Replace(legalSheetName, "*", "")
legalSheetName = Replace(legalSheetName, "?", "")
legalSheetName = Replace(legalSheetName, "/", "")
legalSheetName = Replace(legalSheetName, "\", "")
legalSheetName = Replace(legalSheetName, ".", "")
legalSheetName = Replace(legalSheetName, " ", "")
legalSheetName = Left(legalSheetName, 31)
For Each cht In ActiveWorkbook.Charts
If cht.Name = legalSheetName Then Exit For
Next cht
If (Not cht Is Nothing) Then
cht.Delete
End If
Charts.Add.Name = legalSheetName
Set cht = Charts(legalSheetName)
If (cht Is Nothing) Then
MakeAGraph = "Failed to create chart: " & grphName & " with legal sheet name: " & legalSheetName
Exit Function
End If
While (cht.SeriesCollection.Count > 0)
cht.SeriesCollection(1).Delete
Wend
cht.HasTitle = True
cht.ChartTitle.Text = title
cht.ChartTitle.Font.Size = 16
cht.ChartType = xlXYScatterLines
' X axis
Dim XA As Excel.Axis
Set XA = cht.Axes(xlCategory)
XA.HasMajorGridlines = True
XA.HasMinorGridlines = True
XA.HasTitle = True
XA.AxisTitle.Characters.Text = xAxisTitle
XA.AxisTitle.Font.Size = 14
XA.AxisTitle.Font.Color = vbRed
' Y axis
Dim YA As Excel.Axis
Set YA = cht.Axes(xlValue, xlPrimary)
YA.HasMajorGridlines = True
YA.HasMinorGridlines = True
YA.HasTitle = True
YA.AxisTitle.Characters.Text = YA2AxisTitle 'titles switched
YA.AxisTitle.Font.Size = 14
YA.AxisTitle.Font.Color = vbBlue
' Second Y Axis
Dim YA2 As Excel.Axis
Set YA2 = cht.Axes(xlValue, xlSecondary)
YA2.HasMajorGridlines = True
YA2.HasMinorGridlines = True
YA2.HasTitle = True
YA2.AxisTitle.Characters.Text = yAxisTitle 'titles switched
YA2.AxisTitle.Font.Size = 14
YA2.AxisTitle.Font.Color = vbBlue
' Legend
cht.Legend.Font.Size = 12
Dim lastRow As Long
Dim serXRange As String
Dim serYRange As String
Dim serY2Range As String
Dim seriesColor As Long
Dim serName As String
Dim serFormula As String
Dim fromSheetName As String
Dim ser As Series
Dim cell As Long
Dim shtInfo As Worksheet
Set shtInfo = Worksheets("Info")
For cell = 1 To NumberOfCells()
If (isChecked(cell)) Then
fromSheetName = CStr(cell) & tabNameExtension
If SheetExistsWithName(fromSheetName) Then
If (Sheets(fromSheetName).Range(EXISTING_DATA_CHECK) <> "") Then
lastRow = GetLastRowNumberFromColumnNamed(Sheets(fromSheetName), colX)
serXRange = "'" & fromSheetName & "'!" & colX & START_DATA_ROW & ":" & colX & lastRow
serYRange = "'" & fromSheetName & "'!" & colY & START_DATA_ROW & ":" & colY & lastRow
serName = shtInfo.Cells(cell + 4, 4) & "-1"
serFormula = "=SERIES(""" & serName & """," & serXRange & "," & serYRange & "," & cell & ")"
Set ser = cht.SeriesCollection.NewSeries
ser.Name = serName
ser.Formula = serFormula
seriesColor = shtCellList.Range("D2").Offset(cell, 0).Interior.Color
ser.Border.Color = seriesColor
ser.MarkerBackgroundColor = seriesColor
ser.MarkerForegroundColor = seriesColor
ser.MarkerSize = 2
ser.Format.Line.Weight = 0
If YA2AxisTitle = "" Then
Else
serName = shtInfo.Cells(cell + 4, 4) & "-2"
serY2Range = "'" & fromSheetName & "'!" & ColY2 & START_DATA_ROW & ":" & ColY2 & lastRow
serFormula = "=SERIES(""" & serName & """," & serXRange & "," & serY2Range & "," & fromSheetName & ")"
Set ser = cht.SeriesCollection.NewSeries
ser.Name = serName
ser.Formula = serFormula
ser.AxisGroup = xlSecondary
ser.Border.Color = seriesColor
ser.MarkerBackgroundColor = seriesColor
ser.MarkerForegroundColor = seriesColor
ser.MarkerSize = 2
ser.Format.Line.Weight = 0
End If
End If
End If
End If
Next cell
End Function
- - - Updated - - -
Also the line that is giving me an error is Set YA2 = cht.Axes(xlValue, xlSecondary), this line will work however if i get rid of xlValue and just leave the secondary inside the ( )