"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

 

[MKLAQ]

impressive ! this is exactly what I look for .
thank you so much for your assistance

 

[MKLAQ]

NOTE : as to macro KeepRangeTogether , I would understand this part

ResetAllHPageBreaks ws                  ' remove all manual added horizontal page breaks
    With ws

because it gives error object required . I change ws to Sht and works well .

 

[BSALV]

a little bit late and another approach.
Suppose that your printarea is not a contigious range or in case it is, you can add hidden rows between them, so that you can point to the different pages as separete contigious ranges.
Now, with VBA or manually, you define the printarea in the different wanted pages and play a little bit around with the pagesetup for fitting the pages.
You can do it a little bit similar with a selection.
You don't need any pagebreaks anymore.

Sub Workaround()
     With ActiveSheet
          With .PageSetup
               .Zoom = False
               .FitToPagesWide = 1
          End With

          .PageSetup.PrintArea = Range("A1:j400").Address
          .PrintPreview                                         'results in 7 pages

          .PageSetup.PrintArea = Range("A1:j20").Address & "," & Range("A22:j25").Address & "," & Range("A27:j37").Address & "," & Range("A39:j45").Address
          .PrintPreview                                         'results in 4 pages
     End With
End Sub

 

[BSALV]

MKLAQ.xlsm
this works good when then string for the printarea/UNION is less then 255 characters ( approx. <18-19 pages)
1 contigious printarea of 400 rows is splitted in blocks of 10 rows with alternating the column K added or not.
In that way, you can create "non-contigious" contigious ranges, so you don't have to add hidden rows.

Sub Workaround_Until_255Char()
     Dim UN    As Range
     With ActiveSheet
          With .PageSetup
               .Zoom = False
               .FitToPagesWide = 1
          End With
          Set c = .Range("A1:J400")

          .PageSetup.PrintArea = c.Address
          .PrintPreview                                         'results in 7 pages

          For i = 0 To c.Rows.Count - 1 Step 10
               b = Not b
               Set c1 = Intersect(c.Resize(, c.Columns.Count + 1), c.Offset(i).Resize(10, c.Columns.Count - b)) 'alternate with an additional empty K-columns
               If UN Is Nothing Then
                    Set UN = c1
               Else
                      Set UN = Union(UN, c1)
               End If
          Next

          .PageSetup.PrintArea = UN.Address
          .PrintPreview                                         'results in only19 pages of the 40 because of limited to 255 characters
     '
     End With
End Sub

 

[MKLAQ]

@BSALV why the pages should be 7 . I supposes for each 10 rows should be in one page for Print Preview , then based on your file should be much more than 7 pages .

 

[GWteB]

NOTE : as to macro KeepRangeTogether , I would understand this part

ResetAllHPageBreaks ws ' remove all manual added horizontal page breaks
With ws

because it gives error object required . I change ws to Sht and works well .

Indeed, the ws variable had to be replaced by the Sht variable.
I don't know how I could have overlooked this sloppy error, but you solved it perfectly!

 

[BSALV]

. I supposes for each 10 rows should be in one page for Print Preview , then based on your file should be much more than 7 pages

the first printpreview was a normal pagesetup with in this case 53 lines per pages resulting in 8 pages, 1 page mistake.
The 2nd printpreview was the one, i wanted to demonstrate. By just making the the ranges aren't equal rectangles, you can separate your printarea in different pages.
The string for the printarea is limited to 255 characters, that is enough for approx. 18 different ranges/pages.
So instead of placing pagebreaks, you define ranges, with alternating number of columns (and if the last column wasn't empty, you hide him for a few seconds).

Working with pagebreaks is sometimes a real pain in the ***, so this is perhaps an nice workaround.
If you upload an example of your file (or a lookalike) and what you want as printout, i can demonstrate this way of thinking.