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

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

Hi Janis, It is hard to tell for sure, but I would check the value of the
page break count. If it is less than two, then the compiler wouldn't find
item(2), ergo the error message. Anyhow, that is what the message is telling
you. It can't find one or the other of the Items.

"Janis" wrote:

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

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

After a lot of thinking about your postings, why don't you removed all the
Pagebreaks using VBA? The re-insert them as adds. It will be easier to do
this, then trying to move around the ones that already exist.

"JLGWhiz" wrote:

Hi Janis, It is hard to tell for sure, but I would check the value of the
page break count. If it is less than two, then the compiler wouldn't find
item(2), ergo the error message. Anyhow, that is what the message is telling
you. It can't find one or the other of the Items.

"Janis" wrote:

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

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

I tested it over and over again. I tried it with all the macros. I tried it
on a sheet with only 5 pages. I noticed that x was only 4. I also noticed
that rowsperpage was 0 again. I got the subscript out of range runtime error
9. I put in the if block as suggested and it stopped in exactly the same
place.

ActiveWindow.View = xlNormalView
x = ActiveSheet.HPageBreaks.Count
If x 2 Then
With ActiveSheet.HPageBreaks
RowsPerPage = .Item(2).Location.Row - .Item(1).Location.Row
End With
End If

Since there are at least 4 pagebreaks in the count then I think that the
theory it is not counted isn't correct. What else can I check?

tia,

"Joel" wrote:

After a lot of thinking about your postings, why don't you removed all the
Pagebreaks using VBA? The re-insert them as adds. It will be easier to do
this, then trying to move around the ones that already exist.

"JLGWhiz" wrote:

Hi Janis, It is hard to tell for sure, but I would check the value of the
page break count. If it is less than two, then the compiler wouldn't find
item(2), ergo the error message. Anyhow, that is what the message is telling
you. It can't find one or the other of the Items.

"Janis" wrote:

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

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

I think you may want to add and if statement where it checks whether there
are any Pagebreaks or not; rightnow it fails because is looking for the
second page break and it probably does not exist.
Try something like this after your statement
x = ActiveSheet.HPageBreaks.Count

If x2 then
With ActiveSheet.HPageBreaks
RowsPerPage = .Item(2).Location.Row - .Item(1).Location.Row ' this is
where it fails
End With

End if

Or something to that effect

--
If this posting was helpful, please click on the Yes button.
Regards,

Michael Arch.




"Janis" wrote:

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

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

That didn't help exactly. I still got the subscript out of range. However,
I did think of something I manually turned on the page break view to make
sure there were page breaks. Then I ran the macro. This time it went past
that error of
RowsPerPage = .Item to

to this line

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

I hope you are still reading this. I marked it answered.

Janis

"Michael" wrote:

I think you may want to add and if statement where it checks whether there
are any Pagebreaks or not; rightnow it fails because is looking for the
second page break and it probably does not exist.
Try something like this after your statement
x = ActiveSheet.HPageBreaks.Count

If x2 then
With ActiveSheet.HPageBreaks
RowsPerPage = .Item(2).Location.Row - .Item(1).Location.Row ' this is
where it fails
End With

End if

Or something to that effect

--
If this posting was helpful, please click on the Yes button.
Regards,

Michael Arch.




"Janis" wrote:

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

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

I ran the script and checked the value of x right before the place it fails
rowsperpage
I got a value of 9 on a smaller sheet in the immediate window. I noticed
rowsperpage was 0. It stopped again on the same place rowsperpage with the
same error even with that added if block. I also tried running all the
macros that run together to do this job in the case that somewhere else it
sets the page breaks.
I notice if I set it in preview mode it always takes it out of preview mode.

"Janis" wrote:

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

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