Question : Conditional page break in excel macro

I receive a few files monthly that comes without formatting and includes information for several employees on the same worksheet. I am trying to build a macro that will format the page, inlcuding page breaks, for printing. The format piece I think I have donw fine but I am struggling with the page breaks. The original file format varies enough that I cannot set page breaks at prescribed points. The number of employees 'sections' in each file varies as well. Each section for an individual employee contains the same unique wording in a cell. Here is my attempt that is failing - I receive run-time erorr 1004: Application -defined or object defined error on the line that sets the HPageBreak. I appreciate your time and help

Code Snippet:

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:



Sub MakePageBreaks()
Dim c As Range
Dim firstaddress As String
Dim FindWhat As String
 
FindWhat = "             QJD TECHNICIAN PERFORMANCE REPORT"
With ActiveSheet.Cells
    Set c = .Find(FindWhat, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            ActiveSheet.HPageBreaks.Add before:=c.Offset(0)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End With
End Sub

Open in New Window

Select All

Answer : Conditional page break in excel macro

Your main problem was the fact that your workbook was set up to print 1 page tall x 1 page wide in the File...Page Setup...Page menu item. I changed the zoom setting to 60% using the "Adjust to" field so the page width would work in Landscape.

I also needed to remove the existing page breaks (you had 52) and wrote a macro for that purpose. The snippet below contains some minor tweaks to your original macro plus the one to remove page breaks.

Brad

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:



Sub MakePageBreaks()
Dim c As Range
Dim FirstAddress As String
Dim FindWhat As String
 
FindWhat = "QJD TECHNICIAN PERFORMANCE REPORT"
With ActiveSheet.Cells
    Set c = .Find(FindWhat, LookIn:=xlValues, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not c Is Nothing Then
        FirstAddress = c.Address
        Do
            If c.Row > 1 Then ActiveSheet.HPageBreaks.Add Before:=c
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAddress
    End If
End With
End Sub
 
Sub RemovePageBreaks()
Dim hb As HPageBreak
Dim cel As Range, celHome As Range
Dim i As Integer, n As Integer
Set celHome = ActiveCell
Cells(Rows.Count, Columns.Count).Select     'A bug in some Excel versions makes this step necessary
n = ActiveSheet.HPageBreaks.Count
If n > 0 Then
    On Error Resume Next
    For i = n To 1 Step -1
        Set hb = ActiveSheet.HPageBreaks(i)
        hb.Delete
    Next
    On Error GoTo 0
End If
Application.Goto celHome
End Sub

Open in New Window

Select All