J
Janis
I get a subscript out of range on the line with the asterisks in the page
setup sub. It runs through the getsubtotal and issubtotal functions several
times before it gets this runtime error. Is it because Excel is overloaded?
It runs through the functions to see if it is a subtotal row and then it does
the subtotal. This is done in the functions to take the load off the
pagesetup macro. The sheets are long about 20 pages.
Any ideas would be appreciated.
Janis
-----------subroutine------------
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
-----functions---------
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
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
setup sub. It runs through the getsubtotal and issubtotal functions several
times before it gets this runtime error. Is it because Excel is overloaded?
It runs through the functions to see if it is a subtotal row and then it does
the subtotal. This is done in the functions to take the load off the
pagesetup macro. The sheets are long about 20 pages.
Any ideas would be appreciated.
Janis
-----------subroutine------------
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
-----functions---------
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
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