J
Janis
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
Before:=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
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
Before:=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