Macro that inserts hard page breaks

[dmcnab]

Good morning, all...I am attaching a sample calendar file for 2014, showing hard page breaks after each Saturday. If you change the year from 2014 to another year, you will see that the hard page breaks don't shift....I am looking for some help finding a macro that will insert hard page breaks after each Saturday, no matter what year it is...thank you

[HansV]

Right-click the sheet tab.
Select View Code from the context menu.
Copy the following code into the module:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Const DateRow = 4
    Const FirstCol = 4
    Dim i As Long
    Dim c As Long
    Dim LastCol As Long
    If Not Intersect(Range("C4"), Target) Is Nothing Then
        For i = Me.VPageBreaks.Count To 1 Step -1
            Me.VPageBreaks(i).Delete
        Next i
        LastCol = Me.Cells(DateRow, Me.Columns.Count).End(xlToLeft).Column
        For c = FirstCol + 1 To LastCol
            If Weekday(Me.Cells(DateRow, c).Value) = 1 Then
                Me.VPageBreaks.Add Before:=Me.Cells(DateRow, c)
            End If
        Next c
    End If
End Sub

[dmcnab]

Hi Hans...I inserted the code you gave me but it produces an error in line " Me.VPageBreaks(i).Delete"....see attachment...I tried using 'Remove' instead of 'Delete' but that didn't work...:(

[HansV]

I see - I tested in Normal View and it worked. Apparently one cannot remove page breaks using code while in Page Break Preview or Page Layout View.
The following version switches to Normal View temporarily to avoid the error.

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Const DateRow = 4
    Const FirstCol = 4
    Dim i As Long
    Dim c As Long
    Dim LastCol As Long
    Dim CurView As XlWindowView
    If Not Intersect(Range("C4"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        CurView = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        For i = Me.VPageBreaks.Count To 1 Step -1
            Me.VPageBreaks(i).Delete
        Next i
        LastCol = Me.Cells(DateRow, Me.Columns.Count).End(xlToLeft).Column
        For c = FirstCol + 1 To LastCol
            If Weekday(Me.Cells(DateRow, c).Value) = 1 Then
                Me.VPageBreaks.Add Before:=Me.Cells(DateRow, c)
            End If
        Next c
        ActiveWindow.View = CurView
        Application.ScreenUpdating = True
    End If
End Sub

[Rudi]

Hi Hans,

Your version worked for me without errors while in Page Layout View.
It did however not remove all hard breaks...one remained each time after the loop had run.

I changed the code to this, and it worked very well, removing all hard breaks before creating the new ones:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Const DateRow = 4
    Const FirstCol = 4
    Dim i As Long
    Dim c As Long
    Dim LastCol As Long
    If Not Intersect(Range("C4"), Target) Is Nothing Then
        ActiveSheet.ResetAllPageBreaks
        LastCol = Me.Cells(DateRow, Me.Columns.Count).End(xlToLeft).Column
        For c = FirstCol + 1 To LastCol
            If Weekday(Me.Cells(DateRow, c).Value) = 1 Then
                Me.VPageBreaks.Add Before:=Me.Cells(DateRow, c)
            End If
        Next c
    End If
End Sub

[HansV]

Thanks, that's shorter and better.

[dmcnab]

Thank you Hans and Rudy.....I took another look at my sample and I noticed that I forgot to ask about code for the same thing (see Sheet2) inserting hard page breaks at the end of each month (ie: before the 1st day of each month, commencing with Feb 1st)........I have tried to adapt the code that Rudy provided but it stops partway through....obviously, I haven't got it right...would you take a look at the work that I have done on page 2, and see if you can correct the code?..........originally, I was hoping that I could just change the year in 1 location and have it copy thru to each sheet, but I see that these are Worksheet change events, and so I'll have to change the year manually on each sheet, but that is a minor thing if I am able to use a WS Change event to set hard page breaks....thanks again--see attached file with my code on Sheet2

[HansV]

The syntax of Cells is Cells(row_number, column_number).
You used Cells(column_number, row_number) instead; that won't do what you want.
Furthermore, for the month you don't want to check the Weekday of the date but the Day of the date.
Use xlUp instead of xlToBottom

Try this version of the Worksheet_Change event procedure for Sheet2:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Const DateCol = 3
    Const FirstRow = 3
    Dim r As Long
    Dim LastRow As Long
    If Not Intersect(Range("A2"), Target) Is Nothing Then
        ActiveSheet.ResetAllPageBreaks
        LastRow = Me.Cells(Me.Rows.Count, DateCol).End(xlUp).Row
        For r = FirstRow + 1 To LastRow
            If Day(Me.Cells(r, DateCol).Value) = 1 Then
                Me.HPageBreaks.Add Before:=Me.Cells(r, DateCol)
            End If
        Next r
    End If
End Sub

If you want to change the year on Sheet1 and have Sheet2 automatically adjust with it:
Enter the formula =Sheet1!C4 in A2 on Sheet2.
Remove the Worksheet_Change event procedure of Sheet2.
Change that of Sheet1 to:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    ' For Sheet1
    Const DateRow = 4
    Const FirstCol = 4
    Dim c As Long
    Dim LastCol As Long
    ' For Sheet2
    Const DateCol = 3
    Const FirstRow = 3
    Dim r As Long
    Dim LastRow As Long
    ' Has the year been changed?
    If Not Intersect(Range("C4"), Target) Is Nothing Then
        ' Handle the active sheet
        With Me
            .ResetAllPageBreaks
            LastCol = .Cells(DateRow, .Columns.Count).End(xlToLeft).Column
            For c = FirstCol + 1 To LastCol
                If Weekday(.Cells(DateRow, c).Value) = 1 Then
                    .VPageBreaks.Add Before:=.Cells(DateRow, c)
                End If
            Next c
        End With
        ' Handle Sheet2
        With Worksheets("Sheet2")
            .ResetAllPageBreaks
            LastRow = .Cells(.Rows.Count, DateCol).End(xlUp).Row
            For r = FirstRow + 1 To LastRow
                If Day(.Cells(r, DateCol).Value) = 1 Then
                    .HPageBreaks.Add Before:=.Cells(r, DateCol)
                End If
            Next r
        End With
    End If
End Sub

See the attached version - it uses the latter version.

Seeking macro for inserting hard page breaks.xlsm

[dmcnab]

Thanks, again, Hans...I have d/loaded the file and will check it out and get back to you...ttyl

[dmcnab]

Good morning, again Hans.....I have been working with the code you gave me. I added an Input sheet (which is where data will be entered), and even though the code inserts hard page breaks in that sheet, I won't be printing that sheet anyway, so that's not an issue.........the idea is that the year will be changed on InputB2, and the page breaks will be set on the weekly, monthly and yearly. I had to make a couple of changes to your code to make it run on the attached workbook, and so far it's OK...although it seems to 'set' a vertical break in the monthly, I can easily remove it manually and this would only be done on a single occasion when the calendar is created for a new year.

The big problem came in the 4th sheet (yearly). It was working just fine but with one exception -- the yearly sheet has vertical and horizontal hard breaks. I can set the vertical breaks manually on a one time basis, but whenever I create a new calendar (for a new year), it resets all page breaks (and erases the vertical breaks on the yearly).....I tried to change .ResetAllPageBreaks to .ResetVPageBreaks (or some variation of that) but that doesn't solve the problem. I suspect that there is a VBA 'expression' that I am missing..I also tried .ClearVPageBreaks etc etc (guessing at what might work) but to no avail....it's not a huge issue b/c a workaround is to manually enter the vertical breaks at the start of the new year and they should remain in place (unless the year is changed), but I thought that you might take a look at what I have so far and see what you can do, if it's an easy adjustment for you to make? Thanks.

[HansV]

Hello Dan,

You can simply remove the code to add page breaks to the first sheet.

The vertical page break in the Monthly sheet is an automatic page break. To get rid of it, either change the page orientation to landscape, or set page setup to fit to 1 page wide.

As you can easily check in the object explorer (press F2 in the Visual Basic Editor to display it), there is no such command as ResetVPageBreaks or ClearVPageBreaks. The workaround is to recreate the vertical page breaks in the code.

See the attached version.

Seeking macro for inserting hard page breaks for W and M and Y.xlsm

[dmcnab]

Good afternoon, Hans.....I am back at this same post and I attach a different file.....I get 'duplicate' errors when I change the year on the Input sheet...I suspect it is due to how I have altered that code that inserts the hard page breaks, but I cannot figure out how to correct it....would you mind taking another look at what I have done with it? Thanks.

[HansV]

You can declare a constant or variable only once within a procedure. The following causes errors because you have declared DateRow, FirstCol, c and LastCol not once but thrice each:

Code: Select all

    ' For weekly
    Const DateRow = 4
    Const FirstCol = 4
    Dim c As Long
    Dim LastCol As Long
    ' For monthly
    Const DateRow = 6
    Const FirstCol = 5
    Dim c As Long
    Dim LastCol As Long
    ' For yearly
    Const DateRow = 7
    Const FirstCol = 6
    Dim c As Long
    Dim LastCol As Long

You don't need the constants for Input at all, since you don't want the code to run for that sheet.
Moreover, the setup is incorrect - monthly and yearly have the dates in a column, but weekly has the dates in a row, so you cannot handle them the same way.

In the version below, I have declared separate constants and variables for weekly, monthly and yearly, and corrected their values. (r and c are shared between all three, they are generic row and column numbers):

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Shared
    Dim r As Long
    Dim c As Long
    ' For weekly
    Const DateRowWeekly = 4
    Const FirstColWeekly = 4
    Dim LastColWeekly As Long
    ' For monthly
    Const DateColMonthly = 5
    Const FirstRowMonthly = 6
    Dim LastRowMonthly As Long
    ' For yearly
    Const DateColYearly = 6
    Const FirstRowYearly = 7
    Dim LastRowYearly As Long
    ' Has the year been changed?
    If Not Intersect(Range("b2"), Target) Is Nothing Then
         ' Handle weekly
        With Worksheets("weekly")
            .ResetAllPageBreaks
            LastColWeekly = .Cells(DateRowWeekly, .Columns.Count).End(xlToLeft).Column
            For c = FirstColWeekly + 1 To LastColWeekly
                If Weekday(.Cells(DateRowWeekly, c).Value) = 1 Then
                    .VPageBreaks.Add Before:=.Cells(DateRowWeekly, c)
                End If
            Next c
        End With
         ' Handle monthly
        With Worksheets("monthly")
            .ResetAllPageBreaks
            LastRowMonthly = .Cells(.Rows.Count, DateColMonthly).End(xlUp).Row
            For r = FirstRowMonthly + 1 To LastRowMonthly
                If Day(.Cells(r, DateColMonthly).Value) = 1 Then
                    .HPageBreaks.Add Before:=.Cells(r, DateColMonthly)
                End If
            Next r
        End With
        ' Handle yearly
        With Worksheets("yearly")
            .ResetAllPageBreaks
            LastRowYearly = .Cells(.Rows.Count, DateColYearly).End(xlUp).Row
            For r = FirstRowYearly + 1 To LastRowYearly
                If Day(.Cells(r, DateColYearly).Value) = 1 Then
                    .HPageBreaks.Add Before:=.Cells(r, DateColYearly)
                End If
            Next r
            ' Recreate the vertical page breaks
            For c = 9 To 105 Step 2
                .VPageBreaks.Add Before:=.Cells(FirstRowYearly, c)
            Next c
        End With
    End If
End Sub

[dmcnab]

Hi Hans...thank you very much for your help with this macro.....on its own, it is working very nicely, and I think that I understand the structure of the code. I have another question: on the same worksheet where I pasted that code, I also have some code that deals with a data validation list and a combo box that I found posted on Deb Dagliesh's "Contextures" website.....that code (a Worksheet Selection Change) seems to be able to co-exist with the Worksheet Change code you gave me....normally, on this same worksheet, I also have a second set of Worksheet Change code that automatically inserts "Closed" into a calendar to denote holidays [you enter the holidays in A14:A29, and the VBA code inserts "Closed" on the rows where dates match the list of dates entered into A14:A29].......when I paste that code back into the worksheet and run it, I get an error message "Compile error: Ambiguous name detected: Worksheet_Change". I am attaching a copy of all the code on that sheet and you can see your 'pagebreak macro' in green; the "Closed" macro follows in black font; the data validation & combo box code follows in purple and red font.......how can I organize or arrange the Worksheet_Change code so that the two Worksheet_Change macros can co-exist, or so that there is no ambiguity between them?

[HansV]

1) The line Option Explicit must always be at the top of the module, above all procedures (subs) and functions. An you can only have one such line in a module.

2) You can only have one Worksheet_Change procedure for each worksheet, not two or more. (Similarly, you can have only one Worksheet_SelectionChange procedure for each worksheet, etc.)
If you want to run several pieces of code in the Worksheet_Change event, simply combine those pieces within the single Worksheet_Change procedure:

Code: Select all

Private Sub Worksheet_Change(ByVal target As Range)
    ' **** Part One: page breaks ****
    ' Shared
    Dim r As Long
    Dim c As Long
    ' For weekly
    Const DateRowWeekly = 2
    Const FirstColWeekly = 4
    Dim LastColWeekly As Long
    ' For monthly
    Const DateColMonthly = 6
    Const FirstRowMonthly = 12
    Dim LastRowMonthly As Long
    ' For yearly
    Const DateColYearly = 5
    Const FirstRowYearly = 21
    Dim LastRowYearly As Long
    ' For public
    Const DateColPublic = 3
    Const FirstRowPublic = 17
    Dim LastRowPublic As Long
    ' Has the year been changed?
    If Not Intersect(Range("D11"), target) Is Nothing Then
         ' Handle weekly
        With Worksheets("weekly")
            .ResetAllPageBreaks
            LastColWeekly = .Cells(DateRowWeekly, .Columns.Count).End(xlToLeft).Column
            For c = FirstColWeekly + 1 To LastColWeekly
                If Weekday(.Cells(DateRowWeekly, c).Value) = 1 Then
                    .VPageBreaks.Add Before:=.Cells(DateRowWeekly, c)
                End If
            Next c
        End With
         ' Handle monthly
        With Worksheets("monthly")
            .ResetAllPageBreaks
            LastRowMonthly = .Cells(.Rows.Count, DateColMonthly).End(xlUp).Row
            For r = FirstRowMonthly + 1 To LastRowMonthly
                If Day(.Cells(r, DateColMonthly).Value) = 1 Then
                    .HPageBreaks.Add Before:=.Cells(r, DateColMonthly)
                End If
            Next r
        End With
        ' Handle yearly
        With Worksheets("yearly")
            .ResetAllPageBreaks
            LastRowYearly = .Cells(.Rows.Count, DateColYearly).End(xlUp).Row
            For r = FirstRowYearly + 1 To LastRowYearly
                If Day(.Cells(r, DateColYearly).Value) = 1 Then
                    .HPageBreaks.Add Before:=.Cells(r, DateColYearly)
                End If
            Next r
            ' Recreate the vertical page breaks
            For c = 111 To 209 Step 2
                .VPageBreaks.Add Before:=.Cells(FirstRowYearly, c)
            Next c
        End With
        ' Handle public
        With Worksheets("public")
            .ResetAllPageBreaks
            LastRowPublic = .Cells(.Rows.Count, DateColPublic).End(xlUp).Row
            For r = FirstRowPublic + 1 To LastRowPublic
                If Day(.Cells(r, DateColPublic).Value) = 1 Then
                    .HPageBreaks.Add Before:=.Cells(r, DateColPublic)
                End If
            Next r
        End With
    End If
    Dim lRow As Long
    Dim sClosed As String
    Dim oCell As Range
    ' **** End of Part One

    ' **** Part Two: closed ****
    sClosed = "Closed"
    On Error GoTo ErrHandler
    If Not Intersect(target, Range("A15:A30")) Is Nothing Then
        Range("F15:BD381").Replace What:=sClosed, Replacement:=""
        For lRow = 15 To 381
            If Cells(lRow, 4) = sClosed Then
                Range("F" & lRow & ":BD" & lRow).Value = sClosed
            End If
        Next lRow
    End If
    ' **** End of Part Two ****

ExitHandler:
    Exit Sub

ErrHandler:
    MsgBox Err.Number & Err.Description
    Resume ExitHandler
End Sub

(The Worksheet_SelectionChange procedure can remain unchanged)

[dmcnab]

Good evening loungers...I am returning to this post b/c something is no longer working correctly...the attached wbook is a small version of the actual boon, but I think it will illustrate the problem. There are Weekly, Monthly, Yearly, Circuits, Public and Location worksheets. I have removed all sheets except Circuits and Rooms (to comply with file size requirements).....the page layout for weekly and circuits is similar (dates down the left column) altho the 'constants' differ.

When you enter a new year on RoomsD11, it should automatically set new hard page breaks on the various sheets. The code that inserts hard page breaks on various worksheets is showing an error when it comes to the Circuits worksheet...............the code that you see here on the Rooms page was given to me in earlier posts by Hans.....it was working properly until a few hours ago.........it seems to me that the code for Circuits should be similar to that used for weekly, but I am at a complete loss as to what could have caused this problem.....I'm hoping that the attached file is adequate to show the problem..., but is keeps getting hung up on Circuits...any suggestion would be appreciated..thanks.

[HansV]

Cell C377 on the CIRCUITS sheet isn't empty, it contains a series of dots. This causes the macro to loop until C377, but since this cell is not a date, the code fails when it tries to check whether the day number equals 1 (the "signal" for a page break).
If you clear C377 (and B377, while you're at it), the code will run OK again.