run time error. Please help me.

C

countryfan_nt

Hello All,
I have this macro, it page breaks pages however, due to the larg
number of pages I get an error "RUN TIME ERROR 1004". That happen
because the page breaks exceed 1026 pages. Is there anyway to make th
macro stop once it reaches 1026 pages?

Thanks,
Nawaf

Sub STEP3()
Application.Wait Now + TimeValue("00:00:03")

Dim Curr_Base As Long
Dim Prev_Base As Long
Dim i As Long
Dim Loop_Count As Long

ActiveWindow.Activate
Loop_Count = Range(Selection, Selection.End(xlDown)).Count
'MsgBox Loop_Count
For i = 3 To Loop_Count
Range("E" & i).Select
Curr_Base = ActiveWindow.ActiveCell
'MsgBox Curr_Base
If (Curr_Base <> Prev_Base) Then
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell
End If
Prev_Base = Curr_Base
Next i
End Su
 
D

Dave Peterson

Maybe you could add:

if ActiveWindow.SelectedSheets.HPageBreaks.Count > 1025 then
'don't do it
else
'go ahead and add it.
end if
 
J

JustinLabenne

countryfan_nt said:
Hello All,
I have this macro, it page breaks pages however, due to the large
number of pages I get an error "RUN TIME ERROR 1004". That happens
because the page breaks exceed 1026 pages. Is there anyway to make the
macro stop once it reaches 1026 pages?

Thanks,
Nawaf

Sub STEP3()
Application.Wait Now + TimeValue("00:00:03")

Dim Curr_Base As Long
Dim Prev_Base As Long
Dim i As Long
Dim Loop_Count As Long

ActiveWindow.Activate
Loop_Count = Range(Selection, Selection.End(xlDown)).Count
'MsgBox Loop_Count
For i = 3 To Loop_Count
Range("E" & i).Select
Curr_Base = ActiveWindow.ActiveCell
'MsgBox Curr_Base
If (Curr_Base Prev_Base) Then
ActiveWindow.SelectedSheets.HPageBreaks.Add befo=ActiveCell
End If
Prev_Base = Curr_Base
Next i
End Sub
Click to expand...

Personally I would just add an error handler to it. Adde
screenupdating =false and noticed a bit of a speed improvement here:

Sub STEP3TEST()
Application.Wait Now + TimeValue("00:00:03")

Dim Curr_Base As Long
Dim Prev_Base As Long
Dim i As Long
Dim Loop_Count As Long

With Application
.ScreenUpdating = False

On Error GoTo ErrHandle
ActiveWindow.Activate
Loop_Count = Range(Selection, Selection.End(xlDown)).Count
'MsgBox Loop_Count
For i = 3 To Loop_Count
Range("E" & i).Select
Curr_Base = ActiveWindow.ActiveCell
'MsgBox Curr_Base
If (Curr_Base = Prev_Base) Then
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell
End If
Prev_Base = Curr_Base
Next i

ErrorExit:
.ScreenUpdating = True
End With
Exit Sub
ErrHandle:
MsgBox "Limit Reached"
GoTo ErrorExit
End Su
 
Top