"conditionnal" Page break - How to simplify / shorten code

[jptaz]

Hello, I use this code to insert a page break before a selected range if the said range is split over 2 sheets. However, I have multiple ranges (12 to 15), to which I'd like to apply the same code. There must be a way to simplify / shorten the code, but I don't know how. I've put 3 ranges in my example code but there will be a dozen.

Thank you for your time

Option Explicit

Sub KeepRangeTogether()
    Dim Ws As Worksheet
    Set Ws = Worksheets("Feuil3") 'define worksheet

    Dim RangeToKeep As Range
    Set RangeToKeep = Ws.Range("A17:A28") 'define range you wish to keep together
    
    Dim RangeToKeep2 As Range
    Set RangeToKeep2 = Ws.Range("A58:A70") 'define range you wish to keep together
    
    Dim RangeToKeep3 As Range
    Set RangeToKeep3 = Ws.Range("A100:A115") 'define range you wish to keep together
    
    
    Ws.ResetAllPageBreaks 'remove all manual page breaks
                          '(only needed if this code is run multiple times on the same sheet)

    Dim pb As HPageBreak
    For Each pb In Ws.HPageBreaks 'loop through all page breaks
        If Not Intersect(pb.Location, RangeToKeep) Is Nothing Then 'if a page break intersects your RangeToKeep
            RangeToKeep.EntireRow.PageBreak = xlPageBreakManual 'insert manual page break
            Exit For
                        
        End If
       Next pb
       
      For Each pb In Ws.HPageBreaks 'loop through all page breaks
        If Not Intersect(pb.Location, RangeToKeep2) Is Nothing Then 'if a page break intersects your RangeToKeep
           RangeToKeep2.EntireRow.PageBreak = xlPageBreakManual 'insert manual page break
           Exit For
         
          End If
        Next pb
 
 
      For Each pb In Ws.HPageBreaks 'loop through all page breaks
        If Not Intersect(pb.Location, RangeToKeep3) Is Nothing Then 'if a page break intersects your RangeToKeep
           RangeToKeep3.EntireRow.PageBreak = xlPageBreakManual 'insert manual page break
           Exit For
         
          End If
        Next pb
   
 
End Sub

 

[GWteB]

How about ...

Sub KeepRangeTogether()
    Dim Ws As Worksheet
    Set Ws = Worksheets("Feuil3")                'define worksheet
  
    With Ws
        .ResetAllPageBreaks                      'remove all manual page breaks
        '(only needed if this code is run multiple times on the same sheet)

        SetHorPageBreak .Range("A17:A28")        'define range you wish to keep together
        SetHorPageBreak .Range("A58:A70")        'define range you wish to keep together
        SetHorPageBreak .Range("A100:A115")      'define range you wish to keep together
    End With
End Sub

Public Sub SetHorPageBreak(ByVal argRange As Range)
    Dim pb As HPageBreak
    For Each pb In argRange.Parent.HPageBreaks                    'loop through all page breaks
        If Not Intersect(pb.Location, argRange) Is Nothing Then   'if a page break intersects your RangeToKeep
            argRange.EntireRow.PageBreak = xlPageBreakManual      'insert manual page break
            Exit For
        End If
    Next pb
End Sub

 

[jptaz]

How about ...

Sub KeepRangeTogether()
    Dim Ws As Worksheet
    Set Ws = Worksheets("Feuil3")                'define worksheet
 
    With Ws
        .ResetAllPageBreaks                      'remove all manual page breaks
        '(only needed if this code is run multiple times on the same sheet)

        SetHorPageBreak .Range("A17:A28")        'define range you wish to keep together
        SetHorPageBreak .Range("A58:A70")        'define range you wish to keep together
        SetHorPageBreak .Range("A100:A115")      'define range you wish to keep together
    End With
End Sub

Public Sub SetHorPageBreak(ByVal argRange As Range)
    Dim pb As HPageBreak
    For Each pb In argRange.Parent.HPageBreaks                    'loop through all page breaks
        If Not Intersect(pb.Location, argRange) Is Nothing Then   'if a page break intersects your RangeToKeep
            argRange.EntireRow.PageBreak = xlPageBreakManual      'insert manual page break
            Exit For
        End If
    Next pb
End Sub

Thank you so much, your solution works perfectly

 

[GWteB]

You are welcome and thanks for letting me know

 

[MKLAQ]

@GWteB
I try testing your updating but it gives error subscript out of range in this line

    For Each pb In argRange.Parent.HPageBreaks                    'loop through all page breaks

why doesn't work for me ?

 

[GWteB]

Looks like the argRange argument of this function doesn't point to (i.e doesn't carry a reference of) a valid Range object.
What does the calling code you're using look like?

 

[MKLAQ]

I use the code in post#2
my data from A1: D100
i use this code

Sub KeepRangeTogether()
    Dim Ws As Worksheet
    Set Ws = Worksheets("ORIGINAL")                'define worksheet
  
    With Ws
        .ResetAllPageBreaks                      'remove all manual page breaks
        '(only needed if this code is run multiple times on the same sheet)

        SetHorPageBreak .Range("A1:A20")        'define range you wish to keep together
        SetHorPageBreak .Range("A21:A40")        'define range you wish to keep together
              '
    End With
End Sub

Public Sub SetHorPageBreak(ByVal argRange As Range)
    Dim pb As HPageBreak
    For Each pb In argRange.Parent.HPageBreaks                    'loop through all page breaks
        If Not Intersect(pb.Location, argRange) Is Nothing Then   'if a page break intersects your RangeToKeep
            argRange.EntireRow.PageBreak = xlPageBreakManual      'insert manual page break
            Exit For
        End If
    Next pb
End Sub

 

[GWteB]

It turns out that the HPageBreaks collection object (and the VPageBreaks as well) cannot be accessed via VBA if the worksheet in question is in page break preview mode.
I have modified the existing code.

Sub KeepRangeTogether()
    Dim ws As Worksheet
    Set ws = Worksheets("ORIGINAL")                'define worksheet
  
    Excel.Application.ScreenUpdating = False
    With ws
        .ResetAllPageBreaks                      'remove all manual page breaks
        '(only needed if this code is run multiple times on the same sheet)

        SetHorPageBreak .Range("A1:A20")        'define range you wish to keep together
        SetHorPageBreak .Range("A21:A40")        'define range you wish to keep together
              '
    End With
    Excel.Application.ScreenUpdating = True
End Sub

Public Sub SetHorPageBreak(ByVal argRange As Range)
    Dim pb As HPageBreak, wb As Workbook, ws As Worksheet, vw As XlWindowView

    Set wb = ActiveSheet.Parent
    Set ws = ActiveSheet
    argRange.Parent.Parent.Activate
    argRange.Parent.Activate
    vw = ActiveWindow.View
    ActiveWindow.View = xlNormalView

    For Each pb In argRange.Parent.HPageBreaks                    'loop through all page breaks
        If Not Intersect(pb.Location, argRange) Is Nothing Then   'if a page break intersects your RangeToKeep
            argRange.EntireRow.PageBreak = xlPageBreakManual      'insert manual page break
            Exit For
        End If
    Next pb

    ActiveWindow.View = vw
    wb.Activate
    ws.Activate
End Sub

 

[MKLAQ]

thanks. now there is no error, but code doesn't insert a page break before a selected range correctly .
can you check my dummy file ,please?

MKK.xlsm

Shared with Dropbox

www.dropbox.com

 

[GWteB]

Ah, I see. Well, you may have been misled by the name of the custom method (SetHorPageBreak) but that name doesn't cover its purpose.

The OP's query is focused on a way to determine if a certain range is split over two pages by a horizontal page break. If that's the case then the code needs to insert a (manual) horizontal page break. That's what the code does. The data in your workbook doesn't exceed one page so neither of both ranges (A1:A20 & A21:A40) are split over two pages, so the code doesn't insert a horizontal pagebreak, since there's no need to. You're not wanting a conditional page break, but an unconditional one.
I've renamed the former macro to prevent confusion and added a macro that does what you want. All the code is reposted for completeness.

Public Sub SetUnconditionalHPageBreak()
    Dim Sht As Worksheet
    Set Sht = Worksheets("ORIGINAL") ' change to suit
    With Sht
         .Range("A21").EntireRow.PageBreak = xlPageBreakManual
         .Range("A41").EntireRow.PageBreak = xlPageBreakManual
    End With
End Sub

Public Sub KeepRangeTogether()
    Dim Sht As Worksheet
    Set Sht = Worksheets("ORIGINAL")    ' change to suit
    Excel.Application.ScreenUpdating = False
    ResetAllHPageBreaks ws                  ' remove all manual added horizontal page breaks
    With ws
        KeepOnOnePage .Range("A60:A95")     ' define range you wish to keep together
        KeepOnOnePage .Range("A200:A240")   ' define range you wish to keep together
    End With
    Excel.Application.ScreenUpdating = True
End Sub

Public Sub ResetAllHPageBreaks(ByVal argSht As Worksheet)
    Dim i As Long
    On Error Resume Next
    For i = argSht.HPageBreaks.Count To 1 Step -1
        argSht.HPageBreaks(i).Delete
    Next
End Sub

Public Sub KeepOnOnePage(ByVal argRange As Range)
    Dim pb As HPageBreak, wb As Workbook, ws As Worksheet, vw As XlWindowView
    Set wb = ActiveSheet.Parent
    Set ws = ActiveSheet
    argRange.Parent.Parent.Activate
    argRange.Parent.Activate
    vw = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    For Each pb In argRange.Parent.HPageBreaks                    'loop through all page breaks
        If Not Intersect(pb.Location, argRange) Is Nothing Then   'if a page break intersects your RangeToKeep
            argRange.EntireRow.PageBreak = xlPageBreakManual      'insert manual page break
            Exit For
        End If
    Next pb
    ActiveWindow.View = vw
    wb.Activate
    ws.Activate
End Sub