Chart Macro - Please Help Debug

mayflower

New Member
Joined
Sep 29, 2015
Messages
4
Hi there!
I am new to using macros and have recently inherited a multiple tabbed, multiple workbook, macro formatted beast and have stumbled upon a few issues. I was instructed to click "debug" when there was an issue with the macro and then simply drag the yellow arrow down one row so that the macro can continue to run, however I would like to fix the macro instead of pretend that an issue doesn't exhist. Can someone please help determine what this bug is and how to fix it? I have bolded the two lines that cause an error. These lines are entitled: "ActiveChart.SeriesCollection(1).Points(5).Select".

Thanks so much!

Sub Auto_PageNum()
'
' PageNum Macro
' Macro created on 10/27/09 by XXXXX
' Macro updated June 2012 by XXXXX


Dim wb As Workbook, ws As Worksheet
Dim strPgNo, strResponse
Dim x, y, z


strResponse = MsgBox("Are you sure you want to run the auto page number routine?", vbYesNo + vbCritical + vbDefaultButton2, "Page No?")
z = 1


If strResponse = vbYes Then


updateStatus ("PageNo")
application.ScreenUpdating = False


For Each wb In Workbooks
Select Case wb.Name
Case "QA Package - Part 1.xlsx", "QA Package - Part 2.xlsx", "QA Package - Part 3.xlsx", "QA Package - Part 4 - NonGAAP.xlsx", "QA Package - App C.xlsx"
For Each ws In wb.Worksheets
For x = 2 To 124
If ws.Name = Workbooks("QA Package - Main.xlsm").Sheets("Pages").Cells(x, 10).Value Then
strPgNo = Workbooks("QA Package - Main.xlsm").Sheets("Pages").Cells(x, 12).Value
If strPgNo <> 0 And strPgNo <> "F" Then
ws.PageSetup.CenterFooter = "&""Arial,Regular""&9 " & strPgNo
End If
Exit For
End If
Next x
Next

End Select
z = z + 1
Next

application.ScreenUpdating = True
updateStatus ("Finished")

End If


End Sub


Sub Format_Charts()


'AutoScaleCharts Macro
'Macro created 10/13/2009 by XXXXX
'Macro updated June 2012 by XXXXX


Dim wb As Workbook, ws As Worksheet, co As ChartObject, ch As Chart
Dim tmpMin, tmpMax, tmpMaj
Dim arrColor, arrFonts
Dim strPkg
Dim ChType, ChNum, ChScale, ChColor, ChSeries
Dim x, y, p
Dim Color_Blue As Long
Dim Color_Yellow As Long
Dim Color_Red As Long
Dim Color_Silver As Long
Dim Color_White As Long
Dim Color_Green As Long


Color_Blue = 41
ActiveWorkbook.Colors(Color_Blue) = RGB(48, 76, 178)
Color_Yellow = 44
ActiveWorkbook.Colors(Color_Yellow) = RGB(255, 191, 39)
Color_Red = 3
ActiveWorkbook.Colors(Color_Red) = RGB(213, 21, 46)
Color_Silver = 15
ActiveWorkbook.Colors(Color_Silver) = RGB(94, 126, 149)
Color_White = 34
ActiveWorkbook.Colors(Color_White) = RGB(229, 227, 227)
Color_Green = 4
ActiveWorkbook.Colors(Color_Green) = RGB(0, 133, 34)


strPackage = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range("B42").Value
strPkg = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range("F4").Value '1 = Quarterly Analysis 2 = Budget/AOP
arrColor = Array("K12", "K4", "K16")
arrFont = Array("L12", "L4", "L16")
y = 1


'updateStatus ("Graphs")
'application.ScreenUpdating = False


For Each wb In Workbooks
Select Case wb.Name
Case "QA Package - Part 4 - NonGAAP.xlsx", "QA Package - Part 1.xlsx", "QA Package - Part 2.xlsx", "QA Package - Part 3.xlsx", "QA Package - App C.xlsx"

' If p = 18 Then GoTo tempx ' will stop the retrieval after part 3, and not retrieve App A, B, & C

For Each ws In wb.Worksheets
For Each co In ws.ChartObjects
co.Activate
ChType = Mid(co.Name, 1, 5)
ChNum = Mid(co.Name, 6, 1)
ChScale = Mid(co.Name, 7, 1)
ChColor = Mid(co.Name, 8, 1)
ChSeries = Mid(co.Name, 9, 1)
Debug.Print ChType, ChNum, ChScale, ChColor, ChSeries

'Checks to see if chart should auto scale. If ChScale is set to 0 it will not auto-scale
If ChScale = 1 Then
For Each ax In ActiveChart.Axes
If ax.Type = xlValue Then
ax.Select
With ax
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
'Calculates the minimum and maximum values then divides so there are 5 grid lines in the chart
tmpMax = ax.MaximumScale
tmpMin = ax.MinimumScale
tmpMaj = (tmpMax - tmpMin) / 5
ax.Select
With ax
.MinimumScale = tmpMin
.MaximumScale = tmpMax
.MinorUnitIsAuto = True
.MajorUnit = tmpMaj
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End If
Next
End If

'Checks chart type, color, and series and formats accordingly
If ChColor = 1 Then
Select Case ChType
Case "SmBar", "LgBar"
ActiveChart.SeriesCollection(1).Select
With selection.Interior
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrColor(0)).Value
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(5).Select
With selection.Interior
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrColor(1)).Value
.Pattern = xlSolid
End With
Case "SmStk", "LgStk", "MxStk", "SmSBr", "LgSBr"
For x = 1 To ChSeries
ActiveChart.SeriesCollection(x).Select
With selection.Interior
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrColor(x - 1)).Value
.Pattern = xlSolid
End With
If ChType = "SmStk" Or ChType = "LgStk" Or ChType = "MxStk" Then
On Error Resume Next
Err.Clear
ActiveChart.SeriesCollection(x).DataLabels.Select
If Err.Number <> 1004 Then
With selection.Font
If ActiveSheet.Name = "Yields" And co.Name = "SmStk5112" Then
Else
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrFont(x - 1)).Value
End If
.Background = xlTransparent
End With
End If
Resume
End If
Next x
Case Else
End Select
End If
Next
range("A1").Select
Next
End Select
y = y + 1


Next


'tempx:
Update_ColWidths
'Update_AppA401k


application.ScreenUpdating = True
updateStatus ("Finished")

End Sub


Sub Update_ColWidths()
'
' Macro created on 10/28/2009 by XXXXX
'Macro updated June 2012 by XXXXX


Dim wb As Workbook, ws As Worksheet
Dim strWrkBk As String, strWrkSht As String
Dim strUpdateCols, strPkg, strPrd, x, y, z


z = 1
updateStatus ("Columns")
application.ScreenUpdating = False


strPrd = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range("B4").Value


For Each wb In Workbooks
Select Case wb.Name
Case "QA Package - Part 1.xlsx", "QA Package - Part 2.xlsx", "QA Package - Part 3.xlsx", "QA Package - Part 4 - NonGAAP.xlsx", "QA Package - App C.xlsx"
For Each ws In wb.Worksheets
For x = 2 To 134
If ws.Name = Workbooks("QA Package - Main.xlsm").Sheets("Pages").Cells(x, 10).Value Then
strUpdateCols = Workbooks("QA Package - Main.xlsm").Sheets("Pages").Cells(x, 19).Value
If strUpdateCols = "x" Then
wb.Activate
ws.Select
If strPrd = 7 Then
Columns("A:A").ColumnWidth = 64.43
Columns("B:B").ColumnWidth = 13
Columns("C:C").EntireColumn.Hidden = True
Columns("D:D").EntireColumn.Hidden = True
Columns("E:E").EntireColumn.Hidden = True
Columns("F:F").EntireColumn.Hidden = True
Columns("G:G").ColumnWidth = 13
Columns("H:H").ColumnWidth = 6.29
Else
Columns("A:A").ColumnWidth = 43.71
Columns("B:B").ColumnWidth = 13
Columns("C:C").EntireColumn.Hidden = True
Columns("D:D").ColumnWidth = 13
Columns("E:E").ColumnWidth = 6.29
Columns("F:F").EntireColumn.Hidden = True
Columns("G:G").ColumnWidth = 13
Columns("H:H").ColumnWidth = 6.29
End If
End If
Exit For
End If
Next x
Next
End Select
z = z + 1
Next


application.ScreenUpdating = True
updateStatus ("Finished")


End Sub


Sub Update_AppA401k()


Dim strMyVal
Dim x, y


strMyVal = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range("H42").Value


For x = 1 To 2
Workbooks("Appendix A - Dept Operating Expenses.xlsm").Activate
Sheets("AppA" & x).Select

If strMyVal = 1 Then
Rows("8:8").Select
selection.EntireRow.Hidden = False
'Buffer
Rows("60:60").Select
selection.EntireRow.Hidden = True
Else
Rows("8:8").Select
selection.EntireRow.Hidden = True
'Buffer
Rows("60:60").Select
selection.EntireRow.Hidden = False
End If

range("A1").Select
Next x


Workbooks("QA Package - Main.xlsm").Activate
Sheets("Main").Select


End Sub


Sub Format_Charts_CurPg()
'
' AutoScaleCharts Macro
' Macro created 10/13/2009 by XXXXX
'Macro updated June 2012 by XXXXX


Dim wb As Workbook, ws As Worksheet, co As ChartObject, ch As Chart
Dim tmpMin, tmpMax, tmpMaj
Dim arrColor, arrFonts
Dim SrsFont1, SrsFont2, SrsFont3
Dim ChType, ChNum, ChScale, ChColor, ChSeries
Dim x
Dim Color_Blue As Long
Dim Color_Yellow As Long
Dim Color_Red As Long
Dim Color_Silver As Long
Dim Color_White As Long
Dim Color_Green As Long


Color_Blue = 41
ActiveWorkbook.Colors(Color_Blue) = RGB(48, 76, 178)
Color_Yellow = 44
ActiveWorkbook.Colors(Color_Yellow) = RGB(255, 191, 39)
Color_Red = 3
ActiveWorkbook.Colors(Color_Red) = RGB(213, 21, 46)
Color_Silver = 15
ActiveWorkbook.Colors(Color_Silver) = RGB(94, 126, 149)
Color_White = 34
ActiveWorkbook.Colors(Color_White) = RGB(229, 227, 227)
Color_Green = 4
ActiveWorkbook.Colors(Color_Green) = RGB(0, 133, 34)


arrColor = Array("K12", "K4", "K16")
arrFont = Array("L12", "L4", "L16")


For Each co In ActiveSheet.ChartObjects
co.Activate
ChType = Mid(co.Name, 1, 5)
ChNum = Mid(co.Name, 6, 1)
ChScale = Mid(co.Name, 7, 1)
ChColor = Mid(co.Name, 8, 1)
ChSeries = Mid(co.Name, 9, 1)
'Debug.Print ChType, ChNum, ChScale, ChColor, ChSeries

'Checks to see if chart should auto scale. If ChScale is set to 0 it will not auto-scale
If ChScale = 1 Then
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
'Calculates the minimum and maximum values then divides so there are 5 grid lines in the chart
tmpMax = co.Chart.Axes(xlValue).MaximumScale
tmpMin = co.Chart.Axes(xlValue).MinimumScale
tmpMaj = (tmpMax - tmpMin) / 5
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = tmpMin
.MaximumScale = tmpMax
.MinorUnitIsAuto = True
.MajorUnit = tmpMaj
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End If

'Checks chart type, color, and series and formats accordingly
If ChColor = 1 Then
Select Case ChType
Case "SmBar", "LgBar"
ActiveChart.SeriesCollection(1).Select
With selection.Interior
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrColor(0)).Value
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(5).Select
With selection.Interior
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrColor(1)).Value
.Pattern = xlSolid
End With

Case "SmStk", "LgStk", "MxStk", "SmSBr", "LgSBr"
For x = 1 To ChSeries
ActiveChart.SeriesCollection(x).Select
With selection.Interior
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrColor(x - 1)).Value
.Pattern = xlSolid
End With
If ChType = "SmStk" Or ChType = "LgStk" Or ChType = "MxStk" Then
On Error Resume Next
Err.Clear
ActiveChart.SeriesCollection(x).DataLabels.Select
If Err.Number <> 1004 Then
With selection.Font
If ActiveSheet.Name = "Yields" And co.Name = "SmStk5112" Then
Else
.ColorIndex = Workbooks("QA Package - Main.xlsm").Sheets("Lookups").range(arrFont(x - 1)).Value
End If
.Background = xlTransparent
End With
End If
Resume
End If
Next x
Case Else
End Select
End If
Next
range("A1").Select

End Sub
 
Last edited:

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Hi and welcome to the MrExcel Message Board!

Guessing somewhat, it may well be that the particular data series does not have 5 points in it. Perhaps it did when the macro was recorded but now it has fewer than 5 so is causing an error when point 5 is found missing.

One way to make it choose the last point, without re-writing the macro, would be to replace:
Code:
ActiveChart.SeriesCollection(1).Points(5).Select
with
Code:
ActiveChart.SeriesCollection(1).Points(ActiveChart.SeriesCollection(1).Points.Count).Select

That is just replacing the hard-coded "5" with a count of the number of points:
Code:
ActiveChart.SeriesCollection(1).Points.Count

It could be something else, in which case you will need to come back.
 
Upvote 0
without debugging the whole routine, and until you have spent time doing that I would be tempted to add On Error Resume Next or similar Error handelling just prior to that one event, then get on with fixing it for the future
 
Upvote 0
Thanks so much! This seams to have solved the issue. Just to clarify does this: ActiveChart.SeriesCollection(1).Points(ActiveChart.SeriesCollection(1).Points.Count).Selects tell excel to count the points in the area and then continue? Trying to understand what the difference is to prevent future issues.
:)
Thanks again!!!
 
Upvote 0
It changes a hard-coded 5 into a "whatever the last number is".

I don't understand what your charts look like so I am having to guess whether it might be useful. However, as long as there are points in SeriesCollection(1) the code should run.
 
Upvote 0

Forum statistics

Threads
1,225,151
Messages
6,183,197
Members
453,151
Latest member
Lizamaison

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top