fit data on new print page

Posted on 2013-10-04
Medium Priority
Last Modified: 2013-10-11
I would like to insert a page break base on the values in the range cannot fit on the page something similar to ms access group together feature in report.
Question by:Svgmassive
  • 2
LVL 26

Accepted Solution

redmondb earned 2000 total points
ID: 39549846
Hi, Svgmassive.

Please see the attached. It's very flexible, handling anything I could think of. However, the result is that it's very slow. "Fancy" page setups, particularly "Fit to wide/tall", can slow it down even more.

Roughly how many rows and Groups do you expect to have?

The code is...
Option Explicit

Sub Group_Entries()
' Careful  - Excel has a maximum of 1,026 horizontal/vertical Page breaks in Excel 2010 (and less in some earlier versions).
Dim i           As Long
Dim xWork       As Long
Dim xView       As Long
Dim xCount      As Long
Dim xLast_Row   As Long
Dim xResponse   As Long
Dim xStart_Row  As Long
Dim xStart_Page As Long
Dim xData       As Variant
Dim xTemp       As Variant
Dim xStartTime  As Variant


xLast_Row = ActiveSheet.UsedRange.Cells(1, 1).Row + ActiveSheet.UsedRange.Rows.Count - 1
If xLast_Row < 2 Then
    MsgBox ("No data found - run cancelled.")
    Exit Sub
End If

xResponse = MsgBox("About to ""Group"" Sheet1 in " & ActiveWorkbook.Name & "." _
            & Chr(10) & " - This could take a long time." _
            & Chr(10) & " - Manual Page Breaks will be cleared." _
            & Chr(10) & " - The Print Area will be reset." _
            & Chr(10) & " - Autofilter will be turned off." _
            & Chr(10) & Chr(10) & "('OK' to Continue, 'Cancel' to Quit.)", vbOKCancel, "Group_Entries")
If xResponse = 2 Then
    MsgBox ("User chose to cancel - run terminating.")
    Exit Sub
End If

xStartTime = Timer
Application.ScreenUpdating = False

    ' Autofilter can cause issues with Page Breaks, so turn if off, if necessary...
    If ActiveSheet.AutoFilterMode Then Selection.AutoFilter

    ' Print Area can cause issues with Page Breaks, so blank it if it's been set...
    If ActiveSheet.PageSetup.PrintArea <> "" Then ActiveSheet.PageSetup.PrintArea = ""

    If ActiveWindow.View <> xlNormalView Then
        xView = ActiveWindow.View
        ActiveWindow.View = xlNormalView
    End If
    Cells.PageBreak = xlNone
    If xView > 1 Then ActiveWindow.View = xView
    xData = Range("A1:A" & xLast_Row)
    xStart_Page = 0
    For i = 1 To UBound(xData)
        If i < UBound(xData) Then xTemp = xData(i + 1, 1) Else xTemp = ""
        If (xData(i, 1) = "" And xTemp <> "") Or i = xLast_Row Then  ' Last entry of a Group...
            If xStart_Page <> 0 Then                           ' So it's neither the first group, nor is the Goup already at the start of a new page.
                xWork = Page_of_Cell(Range("A" & i))
    '            Debug.Print xStart_Page & " - " & xWork
                If xStart_Page <> xWork Then                   ' Group has crossed a page, so we start it on a new page
                    xCount = xCount + 1
                    ActiveSheet.HPageBreaks.Add Before:=Range("A" & xStart_Row)
    '                Debug.Print "Break #" & xcount & " inserted - " & Range("A" & xStart_Row).Address
                End If
            End If
        ElseIf xData(i, 1) <> "" Then                          ' First entry of a Group...
            xStart_Page = Page_of_Cell(Range("A" & i))
            If i = 1 Then
                xWork = 0                                      ' Careful with the first row!
                xWork = Page_of_Cell(Range("A" & i - 1))       ' Get the previous row's Page No. in case this Group already starts a page.
            End If
            If xWork <> xStart_Page Then
                xStart_Page = 0                                ' Already at the start of a page.
                xStart_Row = i                                 ' Not at the start of a page, so remember the Gtoup's first Row.
            End If
        End If
Application.ScreenUpdating = True

Debug.Print "Grouping complete. " & xCount & " Page Breaks inserted in " & Format(Timer - xStartTime, "#,##0") & " seconds."
MsgBox "Grouping complete. " & xCount & " Page Breaks inserted in " & Format(Timer - xStartTime, "#,##0") & " seconds."

End Sub

Function Page_of_Cell(xcell As Range) As Long
' We only need to know whether we're on a *different* page, so this saves a bit of time by ignoring vertical page breaks and so may not give the *actual* page.
' (Underlying idea from http://www.pcreview.co.uk/forums/add-page-number-and-pages-number-cell-t1034189.html)
Dim i     As Long
Dim xTemp As Long
Dim xPage As Long

'Force Excel to recalculate the number of pages...
If ActiveSheet.PageSetup.Pages().Count = 0 Then Debug.Print "This message only appears for an empty sheet."

xPage = 1

For i = 1 To ActiveSheet.HPageBreaks.Count
    xTemp = 0
    On Error Resume Next
        xTemp = ActiveSheet.HPageBreaks(i).Location.Row
    On Error GoTo 0
    If xTemp = 0 Or xTemp > xcell.Row Then Exit For
    xPage = xPage + 1

Page_of_Cell = xPage

End Function

Open in new window


Author Comment

ID: 39564780
great redmondb
LVL 26

Expert Comment

ID: 39564868
Thanks, Svgmassive.

Featured Post

Train for your Pen Testing Engineer Certification

Enroll today in this bundle of courses to gain experience in the logistics of pen testing, Linux fundamentals, vulnerability assessments, detecting live systems, and more! This series, valued at $3,000, is free for Premium members, Team Accounts, and Qualified Experts.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
Manually copying shapes and their assigned macros one by one to a new location can be tedious, but if you use the Excel utility workbook attached to this article, the process will be much quicker and easier.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…

624 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question