runtime error 9 out of range subscript
 

I get a runtime error 9 out of range subscript on the line marked with an
asterisk.
Most of the sheets are 20 pages long. It runs through about 5
iterations of the subscript and then I get this runtime error. Can you tell
me what to try? The purpose of the getsubtotal function is to get it to
subtotal in the function so the pageset up macro doesn't overload excel.

tia,


Sub VOD_11x17_Page_Setup()

'This is the new page set up without column B for sheets + VOD_v2.
Dim x As Integer
Dim I As Integer
Dim K As Integer
Dim J As String
Dim C As Range
Dim PageNumber As Long
Dim SubTotalRow As Long
Dim Test As Boolean
Dim Row1 As Integer

Dim AC_Sheet As Worksheet
Dim AW As Workbook
Dim AW_Name As String
Dim UsedRange1 As Range
Dim UsedRows1 As Long
Dim UsedCol1 As Long
Dim SubTotalRows As Variant
Dim RowsPerPage As Long

Application.ActiveSheet.UsedRange
Set AC_Sheet = Application.ActiveSheet
Set AW = Application.ActiveWorkbook
AW_Name = AW.name
Set UsedRange1 = AC_Sheet.UsedRange
UsedRows1 = UsedRange1.Rows.Count
UsedCol1 = UsedRange1.Columns.Count


SubTotalRows = GetSubTotalRows()


Application.ActivePrinter = "\\martinezfs1-bay\CA-Martinez-94C on Ne02:"
PS411x17
Application.ScreenUpdating = False
With ActiveSheet.PageSetup
.PrintArea = ""
.PrintTitleRows = "$1:$11"
.PrintTitleColumns = ""
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 99
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveSheet.DisplayPageBreaks = True
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.ResetAllPageBreaks

ActiveWindow.View = xlNormalView
x = ActiveSheet.HPageBreaks.Count
With ActiveSheet.HPageBreaks
**** RowsPerPage = .Item(2).Location.Row - .Item(1).Location.Row ****
End With
K = 1
PageNumber = 1
Row1 = 0

For I = 0 To UBound(SubTotalRows)
SubTotalRow = SubTotalRows(I)
If Row1 = 0 Then
Row1 = ActiveSheet.HPageBreaks(PageNumber).Location.Row
End If
'
If SubTotalRow Row1 Then
ActiveWindow.SelectedSheets.HPageBreaks.Add
Befo=Cells(SubTotalRows(I - 1) + 1, 1)
Row1 = SubTotalRows(I - 1) + RowsPerPage
PageNumber = PageNumber + 11
End If
Next I

For I = 1 To x
If x < ActiveSheet.HPageBreaks.Count Then
I = I - (ActiveSheet.HPageBreaks.Count - x)
K = I + (ActiveSheet.HPageBreaks.Count - x)
x = ActiveSheet.HPageBreaks.Count
End If
J = ActiveSheet.HPageBreaks(K).Location.Address
Row1 = Range(J).Row

Set ActiveSheet.HPageBreaks(K).Location = Cells(Row1, 1)
K = K + 1
Next I

Application.ScreenUpdating = True
ActiveWindow.View = xlNormalView
Range(FirstDataCell).Activate
Range("A1").Activate

End Sub



---------function------------


Private Function IsSubTotalRow(ByVal I As Integer, ByVal x As Integer) As
Boolean
Dim C As Range
Dim Value2 As Variant

IsSubTotalRow = True
For Each C In Range(Cells(I, 1), Cells(I, x))
'C.Select
Value2 = CStr(C.Value2)
If Left(C.Formula, 6) < "=SUMIF" Then
If CStr(C.Value2) < "" Then
IsSubTotalRow = False
End If
End If
Next C


End Function

Private Function GetSubTotalRows()

Dim UsedRange1 As Range
Dim Rows() As Variant
Dim I As Long
Dim UsedCol1 As Long
Dim C As Range




Set UsedRange1 = Intersect(Range(ServiceGroupColumn & FirstDataRow & ":" &
ServiceGroupColumn & ActiveSheet.UsedRange.Rows.Count), ActiveSheet.UsedRange)
Set UsedRange1 = UsedRange1.SpecialCells(xlCellTypeBlanks)

UsedCol1 = UsedRange1.Columns.Count

I = 0
For Each C In UsedRange1
If IsSubTotalRow(C.Row, UsedCol1) = True Then
ReDim Preserve Rows(I)
Rows(I) = C.Row
I = I + 1
End If

Next C

GetSubTotalRows = Rows()


End Function

runtime error 9 out of range subscript
 

I found an error in the function, so I will repost with new info.

"Janis" wrote:

I get a runtime error 9 out of range subscript on the line marked with an
asterisk.
Most of the sheets are 20 pages long. It runs through about 5
iterations of the subscript and then I get this runtime error. Can you tell
me what to try? The purpose of the getsubtotal function is to get it to
subtotal in the function so the pageset up macro doesn't overload excel.

tia,


Sub VOD_11x17_Page_Setup()

'This is the new page set up without column B for sheets + VOD_v2.
Dim x As Integer
Dim I As Integer
Dim K As Integer
Dim J As String
Dim C As Range
Dim PageNumber As Long
Dim SubTotalRow As Long
Dim Test As Boolean
Dim Row1 As Integer

Dim AC_Sheet As Worksheet
Dim AW As Workbook
Dim AW_Name As String
Dim UsedRange1 As Range
Dim UsedRows1 As Long
Dim UsedCol1 As Long
Dim SubTotalRows As Variant
Dim RowsPerPage As Long

Application.ActiveSheet.UsedRange
Set AC_Sheet = Application.ActiveSheet
Set AW = Application.ActiveWorkbook
AW_Name = AW.name
Set UsedRange1 = AC_Sheet.UsedRange
UsedRows1 = UsedRange1.Rows.Count
UsedCol1 = UsedRange1.Columns.Count


SubTotalRows = GetSubTotalRows()


Application.ActivePrinter = "\\martinezfs1-bay\CA-Martinez-94C on Ne02:"
PS411x17
Application.ScreenUpdating = False
With ActiveSheet.PageSetup
.PrintArea = ""
.PrintTitleRows = "$1:$11"
.PrintTitleColumns = ""
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 99
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveSheet.DisplayPageBreaks = True
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.ResetAllPageBreaks

ActiveWindow.View = xlNormalView
x = ActiveSheet.HPageBreaks.Count
With ActiveSheet.HPageBreaks
**** RowsPerPage = .Item(2).Location.Row - .Item(1).Location.Row ****
End With
K = 1
PageNumber = 1
Row1 = 0

For I = 0 To UBound(SubTotalRows)
SubTotalRow = SubTotalRows(I)
If Row1 = 0 Then
Row1 = ActiveSheet.HPageBreaks(PageNumber).Location.Row
End If
'
If SubTotalRow Row1 Then
ActiveWindow.SelectedSheets.HPageBreaks.Add
Befo=Cells(SubTotalRows(I - 1) + 1, 1)
Row1 = SubTotalRows(I - 1) + RowsPerPage
PageNumber = PageNumber + 11
End If
Next I

For I = 1 To x
If x < ActiveSheet.HPageBreaks.Count Then
I = I - (ActiveSheet.HPageBreaks.Count - x)
K = I + (ActiveSheet.HPageBreaks.Count - x)
x = ActiveSheet.HPageBreaks.Count
End If
J = ActiveSheet.HPageBreaks(K).Location.Address
Row1 = Range(J).Row

Set ActiveSheet.HPageBreaks(K).Location = Cells(Row1, 1)
K = K + 1
Next I

Application.ScreenUpdating = True
ActiveWindow.View = xlNormalView
Range(FirstDataCell).Activate
Range("A1").Activate

End Sub



---------function------------


Private Function IsSubTotalRow(ByVal I As Integer, ByVal x As Integer) As
Boolean
Dim C As Range
Dim Value2 As Variant

IsSubTotalRow = True
For Each C In Range(Cells(I, 1), Cells(I, x))
'C.Select
Value2 = CStr(C.Value2)
If Left(C.Formula, 6) < "=SUMIF" Then
If CStr(C.Value2) < "" Then
IsSubTotalRow = False
End If
End If
Next C


End Function

Private Function GetSubTotalRows()

Dim UsedRange1 As Range
Dim Rows() As Variant
Dim I As Long
Dim UsedCol1 As Long
Dim C As Range




Set UsedRange1 = Intersect(Range(ServiceGroupColumn & FirstDataRow & ":" &
ServiceGroupColumn & ActiveSheet.UsedRange.Rows.Count), ActiveSheet.UsedRange)
Set UsedRange1 = UsedRange1.SpecialCells(xlCellTypeBlanks)

UsedCol1 = UsedRange1.Columns.Count

I = 0
For Each C In UsedRange1
If IsSubTotalRow(C.Row, UsedCol1) = True Then
ReDim Preserve Rows(I)
Rows(I) = C.Row
I = I + 1
End If

Next C

GetSubTotalRows = Rows()


End Function