• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel 2016 VBA , How to Insert Horizontal Page Break on Every 2nd occurrence of particular text?

Dear All Experts,

Again Here , but now For Horizontal Page breaks.

Requirement to print 2 data sets on 1 single page.
Horizontal Page break require on every 2nd occurrence of particular text on cell.
Ignore Hidden Rows.

For example, on some sites,I already Try below,

https://answers.microsoft.com/en-us...l-macros/9976e30a-8aae-4bec-84e8-43b35b113ec2
https://answers.microsoft.com/en-us...or-excel/85790a6a-ef93-4354-8ad5-3cc5e4399285
https://www.extendoffice.com/documents/excel/1774-excel-insert-page-break-every-row.html

I already use Below code to put Hpagebreak on every found but now requirement raise as every 2nd occurrence of "DISPATCH JAN TO NOV-22".

Code:
Sub Insert_Pagebreak_On_EveryFoundok()

   Dim MYCOLUMN As Range
   Dim MyCell As Range

   'For Each MyCell In Range("G2:G" & Rows.Count).End.xlUp))
   'For Each MyCell In Range Cells(Rows.Count, 2).End(xlUp).row 2
   
      ActiveSheet.Range("G" & Rows.Count).End(xlUp).row))

      ActiveWindow.view = xlPageBreakPreview
 
      Set MYCOLUMN = ActiveSheet.Range("F2:F" & ActiveSheet.Range("F" & Rows.Count).End(xlUp).row)

    For Each MyCell In MYCOLUMN
       MyCell.Select

         If MyCell.Value Like "*DISPATCH JAN TO NOV-22*" Then

        ActiveCell.EntireRow.Select
         ActiveWindow.SelectedSheets.HPageBreaks.Add
           ActiveCell.offset(1, 0)
   
    Else
 
         ActiveCell.offset(1, 0).Select

      End If
   
     Next

   ActiveWindow.view = xlNormalView

  End Sub

This Loop check every cell that take more time, but I believe if use Range.Find method, then it can be more robust.

I am not knowing very well all aspects of VBA, but I daily use VBA in my many types of daily routine work & without it, I can't complete my work on time.

Currently I manually select 2 sets of data, adjust rows height to fit on A4, select -set-click print area & then print, and after print that I select below further 2 sets & do same thing, till sheet's data end, painfully pass whole my day, just for print 2 data set on 1 A4 page.

There are need to beware for Hidden rows which hides for reason (not requirement in print).
So, condition is only visible rows should be count for 2nd occurrence. I attached Screen shot of whole scenario for reference.
[Please Refer This Image as my Requirement & Situation]
83279
Hundreds of data sets on this worksheet. There should be 2 sets of data as pair require on every A4 size page.
so obviously page break requires on every 2nd occurrence of particular text.

If, that happen successfully, I am ready to manually adjust rows height to readable fit 2 sets in A4 page, so I get whole sheet ready for print in one go.

Hope, I try my best to describe my situation if require further, please mention.
Can anyone help regarding this?
I really appreciate & will be thankful forever.
Regards, Chirag Raval
 

Attachments

  • SAMPLE FILE REQUIRE PAGEBREAK ON EVERY 2ND OCCURANCE.xlsx
    306.7 KB · Views: 4
Hello, a starter beginner level VBA demonstration :​
Code:
Sub Demo1()
           Dim Rf As Range, R&, B%
    With Range(ActiveSheet.PageSetup.PrintArea).Columns(6)
           Set Rf = .Find("(DISPATCH JAN-22 TO NOV-22)", , xlValues, 1)
        If Not Rf Is Nothing Then
           R = Rf.Row
        Do
               If B Then ActiveSheet.HPageBreaks.Add Rf(2): B = 0 Else B = 1
               Set Rf = .FindNext(Rf)
        Loop Until Rf.Row = R
               Set Rf = Nothing
        End If
    End With
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
Dear Sir @Marc L ,
Thank you sir, I checked, its work as expected but after some manually setting.

Before, on every run this code, its force to , explicitly select whole print area (till 1st dataset to end of dataset) & set print area.

so I already try to reset by put ActiveSheet.ResetAllPageBreaks before code goes to find.

Though its reset all page breaks ,( so vertical page break appear before 6th column,
that's not problem because we can manually drag 1 step right/ (1 column right) after run this code.

But,
point is must be print area already set before run this code?

83294

83293
83292
can you face this situation at your end ? after change columns widths & other hide & unhide rows ?
please guide & thanks for your effort.

Regards,
Chirag Raval
 
I forgot to write « according to your attachment » where the print area is already set so the reason why I used it.​
But as a starter you can mod it with another range reference …​
 
Dear Sir @Marc L ,

Before time to work on this file, i will set (1 time only) total width of dataset through adjust individual column width to horizontally fit on vertical A4 paper.

I already put ActiveSheet.ResetAllPageBreaks ,before your "With range(..." line.
& all goes as expected.


Thank you very much for your invaluable guidance & helping code that help me forever !!

Also, Thank you, for this great web site / forum as such a great time & luck for great people connected to this site
with great solutions which rarely found/ appear among thousands of pages on net.

Regards
Chirag Raval
 
First thanks for your kind appreciation as few original posters take the time to well thank helpers !​
I was hesitating for ResetAllPageBreaks 'cause of the vertical page break already set.​
So if you really need it then you may have to drag the vertical page break out of the print area​
like my demonstration revamped with a generic 'DISPATCH' criteria :​
Code:
Sub Demo1r()
           Dim Rf As Range, R&, B%
           ActiveSheet.ResetAllPageBreaks
           ActiveSheet.VPageBreaks(1).DragOff xlToRight, 1
    With Range(ActiveSheet.PageSetup.PrintArea).Columns(6)
           Set Rf = .Find("(DISPATCH *)", , xlValues, 1)
        If Not Rf Is Nothing Then
           R = Rf.Row
        Do
               If B Then ActiveSheet.HPageBreaks.Add Rf(2): B = 0 Else B = 1
               Set Rf = .FindNext(Rf)
        Loop Until Rf.Row = R
               Set Rf = Nothing
        End If
    End With
End Sub
You may Like it !​
 
Dear Sir @Marc L ,

Thank you very much for your update & give me a little effort for me, it works as expected & now no need to manually drag.
Thanks & Regards,

Chirag Raval
 
Back
Top