runtime error 9, subscript out of bounds error #2
 

I accidentally marked the other thread answered and it is getting urgent.
I apologize for any unnecessary confusing.
In the code I pasted in the thread I had some code that was commented out
but I accidentally uncommented and it WAS CONFUSING. Sorry. I tested the
code below over and over with the suggestions ONLY that are commented in
below by JOel and Jim.

I tried them in all combinations. The first suggestion by Jim doesn't
change anything. The second suggestion by Joel doesn't change anything
either. I get a runtime error 9 subscript out of range at the line marked in
asterisks in any case.

There are about 12 pagebreaks in this sheet. I am getting some screen
redraw problems when I run this sometimes. Do I need a better graphics
monitor? I don't know what to check.
tia,

------------entire code -----

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


'RowsPerPage = ActiveSheet.HPageBreaks(2).Location.Row -
ActiveSheet.HPageBreaks(1).Location.Row
With ActiveSheet.HPageBreaks 'added by Tomlinson
**** 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 + 1
End If

' If SubTotalRow Row1 Then 'added by Joel
' Set ActiveSheet.HPageBreaks(PageNumber).Location =
Cells(SubTotalRows(I - 1) + 1, 1)
' Row1 = SubTotalRows(I - 1) + RowsPerPage
' PageNumber = PageNumber + 1
' End If
Next I



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

End Sub


-------------two called 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

runtime error 9, subscript out of bounds error #2
 

please close this thread it is a duplicate.

"Janis" wrote:

I accidentally marked the other thread answered and it is getting urgent.
I apologize for any unnecessary confusing.
In the code I pasted in the thread I had some code that was commented out
but I accidentally uncommented and it WAS CONFUSING. Sorry. I tested the
code below over and over with the suggestions ONLY that are commented in
below by JOel and Jim.

I tried them in all combinations. The first suggestion by Jim doesn't
change anything. The second suggestion by Joel doesn't change anything
either. I get a runtime error 9 subscript out of range at the line marked in
asterisks in any case.

There are about 12 pagebreaks in this sheet. I am getting some screen
redraw problems when I run this sometimes. Do I need a better graphics
monitor? I don't know what to check.
tia,

------------entire code -----

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


'RowsPerPage = ActiveSheet.HPageBreaks(2).Location.Row -
ActiveSheet.HPageBreaks(1).Location.Row
With ActiveSheet.HPageBreaks 'added by Tomlinson
**** 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 + 1
End If

' If SubTotalRow Row1 Then 'added by Joel
' Set ActiveSheet.HPageBreaks(PageNumber).Location =
Cells(SubTotalRows(I - 1) + 1, 1)
' Row1 = SubTotalRows(I - 1) + RowsPerPage
' PageNumber = PageNumber + 1
' End If
Next I



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

End Sub


-------------two called 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