What code does: I have a code, that reads from certain worksheets and uses the data to create a graph.
What I did before: Previously, I was defining the range for this graph using floating methods (such as used range and lastcell). Since there was a problem when one row of data was deleted (see Dynamic referencing the UsedRange in VBA) I changed the reference method, to account for the number of non-empty column headers.
Problem: Although the code seems to be functional for the first graph created, for the other graphs (and before it gets to the second column of data) it is yielding an error (Method "major Unit" of object axis failed) in the line indicated below.
What it was expected to do: Before I change the reference procedure for the range, I was not getting these problems, and the graphs were being constructed properly.
Question: Any ideas of what might be causing this?
Obs1: As suggested in my previous question, I tried producing these graphs using tables, but was not yet able to do that properly.
Code:
Function Grapher(ChartSheetName As String, SourceWorksheet As String, ChartTitle As String, secAxisTitle As String)
Dim lColumn As Long, lRow As Long
Dim LastColumn As Long, LastRow As Long
Dim RetChart As Chart
Dim w As Workbook
Dim RetRange As Range
Dim chrt As Chart
Dim p As Integer
Dim x As Long, y As Long
Dim numMonth As Long
Dim d1 As Date, d2 As Date
Dim i As Long, j As Long
Dim pt As PivotTable
Set w = ThisWorkbook
j = 2
Do While w.Worksheets(SourceWorksheet).Cells(1, j).Text <> ""
j = j + 1
Loop
'find limit
LastColumn = j 'w.Sheets(SourceWorksheet).Cells(1, w.Sheets(SourceWorksheet).Columns.Count).End(xlToLeft).column
LastRow = w.Sheets(SourceWorksheet).Cells(w.Sheets(SourceWorksheet).Rows.Count, "A").End(xlUp).Row
'check for sources that do not have full data
'sets the range
i = 3
If SourceWorksheet = "Ret" Or SourceWorksheet = "Vol" Then
Do While w.Worksheets(SourceWorksheet).Cells(i, 2).Text = "N/A"
i = i + 1
Loop
'pt = w.Sheets(SourceWorksheet).ListObjects.Add(xlSrcRange, Range(w.Worksheets(SourceWorksheet).Cells(i, 1), w.Worksheets(SourceWorksheet).Cells.SpecialCells(xlLastCell)), , xlYes).Name
'Set RetRange = pt.DataBodyRange
Set RetRange = w.Worksheets(SourceWorksheet).Range(w.Worksheets(SourceWorksheet).Cells(i, 1), w.Worksheets(SourceWorksheet).Cells(i, LastColumn))
'Set RetRange = w.Worksheets(SourceWorksheet).Range(w.Worksheets(SourceWorksheet).Cells(i, 1), w.Worksheets(SourceWorksheet).Cells.SpecialCells(xlLastCell))
Else
Set RetRange = w.Sheets(SourceWorksheet).Range(w.Worksheets(SourceWorksheet).Cells(1, 1), w.Worksheets(SourceWorksheet).Cells(LastRow, LastColumn))
'Set RetRange = w.Sheets(SourceWorksheet).UsedRange
'Set RetRange = w.Sheets(SourceWorksheet).Range("A1:" & Col_Letter(LastColumn) & LastRow)
End If
'''''''''''''''''''''''
For Each chrt In w.Charts
If chrt.Name = ChartSheetName Then
Set RetChart = chrt
RetChart.Activate
p = 1
End If
Next chrt
If p <> 1 Then
Set RetChart = Charts.Add
End If
'count the number of months in the time series, do the ratio
d1 = w.Sheets(SourceWorksheet).Range("A2").Value
d2 = w.Sheets(SourceWorksheet).Range("A" & LastRow).Value
numMonth = TestDates(d1, d2)
x = Round((numMonth / 15), 1)
'ratio to account for period size
If x < 3 Then
y = 1
ElseIf x >= 3 And x < 7 Then
y = 4
ElseIf x > 7 Then
y = 6
End If
'create chart
With RetChart
.Select
.ChartType = xlLine
.HasTitle = True
.ChartTitle.Text = ChartTitle
.SetSourceData Source:=RetRange 'change this to be the table
.Axes(xlValue).MaximumScaleIsAuto = True
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = secAxisTitle
.Name = ChartSheetName
.SetElement (msoElementLegendBottom)
.Axes(xlCategory).TickLabelPosition = xlLow
.Axes(xlCategory).MajorUnit = y '************THIS IS GIVING THE CURRENT ERROR
.Axes(xlCategory).MajorUnitScale = xlMonths
'sets header names for modified sources
If SourceWorksheet = "Drawdown" Then
For lColumn = 2 To LastColumn
.FullSeriesCollection(lColumn - 1).Name = "=DD!$" & Col_Letter(lColumn) & "$1"
.FullSeriesCollection(lColumn - 1).Values = "=DD!$" & Col_Letter(lColumn) & "$3:$" & Col_Letter(lColumn) & "$" & LastRow
Next lColumn
ElseIf SourceWorksheet = "Ret" Then
For lColumn = 2 To LastColumn
If w.Sheets("Ret").Cells(1, lColumn).Value <> "" Then
.FullSeriesCollection(lColumn - 1).Name = "='Ret'!$" & Col_Letter(lColumn) & "$1"
Else
.FullSeriesCollection(lColumn - 1).Name = ""
End If
Next lColumn
ElseIf SourceWorksheet = "Vol" Then
For lColumn = 2 To LastColumn
If w.Sheets("Vol").Cells(1, lColumn).Value <> "" Then
.FullSeriesCollection(lColumn - 1).Name = "='Vol'!$" & Col_Letter(lColumn) & "$1"
Else
.FullSeriesCollection(lColumn - 1).Name = ""
End If
Next lColumn
End If
End With
'deleting the extra empty series
Dim nS As Series
'this has to be fixed. For a permanent solution, try to use tables
For Each nS In RetChart.SeriesCollection
If nS.Name = "Series2" Or nS.Name = "Series3" Or nS.Name = "Series4" Or nS.Name = "Series5" Or nS.Name = "" Then
nS.Delete
End If
Next nS
End Function
Function TestDates(pDate1 As Date, pDate2 As Date) As Long
TestDates = DateDiff("m", pDate1, pDate2)
End Function
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Worksheets("TIME SERIES").Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
Try the code below, I "cleand" it a little, and see if it resolved your error on setting the Axes(xlCategory).MajorUnit.
Note: there is no need to Select the chart to modify it.
Function Grapher(ChartSheetName As String, SourceWorksheet As String, ChartTitle As String, secAxisTitle As String)
Dim lColumn As Long, lRow As Long
Dim LastColumn As Long, LastRow As Long
Dim RetChart As Chart
Dim w As Workbook
Dim ws As Worksheet
Dim RetRange As Range
Dim chrt As Chart
Dim p As Integer
Dim x As Long, y As Long
Dim numMonth As Long
Dim d1 As Date, d2 As Date
Dim i As Long, j As Long
Dim pt As PivotTable
Set w = ThisWorkbook
Set ws = w.Worksheets(SourceWorksheet)
With ws
LastColumn = .Range("B1").End(xlToRight).Column ' find last column
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' find last row
' check for sources that do not have full data
' sets the range
i = 3
If SourceWorksheet = "Ret" Or SourceWorksheet = "Vol" Then
Do While .Range("B" & i).Text = "N/A"
i = i + 1
Loop
'Set RetRange = pt.DataBodyRange
Set RetRange = .Range(.Cells(i, 1), .Cells(i, LastColumn))
'Set RetRange = w.Worksheets(SourceWorksheet).Range(w.Worksheets(SourceWorksheet).Cells(i, 1), w.Worksheets(SourceWorksheet).Cells.SpecialCells(xlLastCell))
Else
Set RetRange = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
'Set RetRange = w.Sheets(SourceWorksheet).Range("A1:" & Col_Letter(LastColumn) & LastRow)
End If
End With
' =====================================
For Each chrt In w.Charts
If chrt.Name = ChartSheetName Then
Set RetChart = chrt
' RetChart.Activate
End If
Next chrt
If RetChart Is Nothing Then Charts.Add '<-- no chart found in previous loop
'count the number of months in the time series, do the ratio
d1 = ws.Range("A2").Value
d2 = ws.Range("A" & LastRow).Value
numMonth = DateDiff("m", d1, d2)
x = Round((numMonth / 15), 1)
'ratio to account for period size
If x < 3 Then
y = 1
ElseIf x >= 3 And x < 7 Then
y = 4
ElseIf x > 7 Then
y = 6
End If
' create chart
With RetChart
' .Select
.ChartType = xlLine
.HasTitle = True
.ChartTitle.Text = ChartTitle
.SetSourceData Source:=RetRange 'change this to be the table
.Axes(xlValue).MaximumScaleIsAuto = True
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = secAxisTitle
.Name = ChartSheetName
.SetElement (msoElementLegendBottom)
.Axes(xlCategory).TickLabelPosition = xlLow
.Axes(xlCategory).MajorUnit = y * 30 ' <-- try this
.Axes(xlCategory).MajorUnitScale = 30
' sets header names for modified sources
Select Case ws.Name
Case "Drawdown"
For lColumn = 2 To LastColumn
.FullSeriesCollection(lColumn - 1).Name = "=DD!$" & Col_Letter(lColumn) & "$1"
.FullSeriesCollection(lColumn - 1).Values = "=DD!$" & Col_Letter(lColumn) & "$3:$" & Col_Letter(lColumn) & "$" & LastRow
Next lColumn
Case "Ret"
For lColumn = 2 To LastColumn
If ws.Cells(1, lColumn).Value <> "" Then
.FullSeriesCollection(lColumn - 1).Name = "='Ret'!$" & Col_Letter(lColumn) & "$1"
Else
.FullSeriesCollection(lColumn - 1).Name = ""
End If
Next lColumn
Case "Vol"
For lColumn = 2 To LastColumn
If ws.Cells(1, lColumn).Value <> "" Then
.FullSeriesCollection(lColumn - 1).Name = "='Vol'!$" & Col_Letter(lColumn) & "$1"
Else
.FullSeriesCollection(lColumn - 1).Name = ""
End If
Next lColumn
End Select
End With
'deleting the extra empty series
Dim nS As Series
'this has to be fixed. For a permanent solution, try to use tables
For Each nS In RetChart.SeriesCollection
Select Case nS.Name
Case "Series2", "Series3", "Series4", "Series5", ""
nS.Delete
End Select
Next nS
Set RetChart = Nothing
End Function
'=======================================================================
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Worksheets("TIME SERIES").Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function