Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Manual Page Breaks Based On Groups Of Data

Status
Not open for further replies.

usacomp2k3

Programmer
Aug 5, 2008
3
So basically I have a report that is generated that is broken down into 4 or 5 headers. What I want is basically a way to manually add page breaks for 2 conditions:
*That no section starts at the end of one page and ends on the next; I want to just insert a page break before the section so it is all on the next page.
* That if the first section is more than a page long, that it inserts a new header saying 'section 1 continued..' basically.

I've been able to code it and it functions how I want. However, it takes about 20-30 seconds on a dual-core computer with 2gb of memory to insert these page breaks, so I thought I'd get some expert advice on where the slow-downs are and how I could go about tightening up the code to get it to run faster. (this subprocedure is #15 of 15 when generating the report, and the rest take between 2 and 5 seconds combined).
Code:
Sub Quote_Page_Breaks()
Dim financials_start_row As Integer, financials_start_page As Integer, financials_end_row As Integer, financials_end_page As Integer
Dim recommended_start_row As Integer, recommended_start_page As Integer, recommended_end_row As Integer, recommended_end_page As Integer
Dim standard_end_row As Integer, standard_end_page As Integer
Dim i As Integer, page_break() As Integer
Dim recommended As Boolean
On Error Resume Next
'get the row numbers of the start of each section
If Quote_CE_P_Cab Then standard_end_row = Sheets("Quotation").Range("Q_Options").Row - 1 Else standard_end_row = Sheets("Quotation").Range("Q_Base_Unit").Row - 1
financials_start_row = Sheets("Quotation").Range("Q_Financials").Row
If Quote_Options_Recommendations = True Then
    recommended_start_row = Sheets("Quotation").Range("Q_Recommended").Row
    financials_end_row = recommended_start_row - 2
    recommended_end_row = ActiveCell.SpecialCells(xlLastCell).End(xlToLeft).End(xlUp).Row
Else
    financials_end_row = ActiveCell.SpecialCells(xlLastCell).End(xlToLeft).End(xlUp).Row
    recommended_start_row = 0
    recommended_end_row = 0
End If
'get the row numbers of each page break
ReDim page_break(1)
For i = 1 To ActiveSheet.UsedRange.Rows.Count
     If Rows(i).PageBreak = xlManual Then
        ReDim Preserve page_break(UBound(page_break) + 1)
        page_break(UBound(page_break)) = i
     ElseIf Rows(i).PageBreak = xlAutomatic Then
        ReDim Preserve page_break(UBound(page_break) + 1)
        page_break(UBound(page_break)) = i
     End If
Next
ReDim Preserve page_break(UBound(page_break) + 1)
page_break(UBound(page_break)) = ActiveCell.SpecialCells(xlLastCell).Row
'get the page numbers of each section
For i = 1 To UBound(page_break) - 1
    If (standard_end_row >= page_break(i) And standard_end_row < page_break(i + 1)) Then standard_end_page = i
    If (financials_start_row >= page_break(i) And financials_start_row < page_break(i + 1)) Then financials_start_page = i
    If (financials_end_row >= page_break(i) And financials_end_row < page_break(i + 1)) Then financials_end_page = i
    If Quote_Options_Recommendations = True Then
        If (recommended_start_row > page_break(i) And recommended_start_row < page_break(i + 1)) Then recommended_start_page = i
        If (recommended_end_row >= page_break(i) And recommended_end_row < page_break(i + 1)) Then recommended_end_page = i
    End If
Next
If financials_start_page = 0 Then financials_start_page = UBound(page_break) - 1
If financials_end_page = 0 Then financials_end_page = UBound(page_break) - 1
If recommended_start_page = 0 Then recommended_start_page = UBound(page_break) - 1
If recommended_end_page = 0 Then recommended_end_page = UBound(page_break) - 1
'check the values and add page breaks if needed
If standard_end_page > 1 Then
    Sheets("Quotation").Rows(page_break(2) & ":" & page_break(2)).Insert shift:=xlDown
    Call Quote_Format_Border(Sheets("Quotation").Range("a1").Offset(page_break(2) - 1, 0).Address, "Standard Specifications continued...")
End If
If financials_start_page <> financials_end_page Then
    Sheets("Quotation").Range("Q_Financials").Select
   ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Selection
End If
If Quote_Options_Recommendations = True Then
    If recommended_start_page <> recommended_end_page Then
        Sheets("Quotation").Range("Q_Recommended").Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Selection
    End If
End If
End Sub

Notes:
The page is broken up into the following named sections:
*Q_Standard_Specifications
*Q_Options (not always present)
*Q_Base_Unit
*Q_Options_Chosen
*Q_Financials
*Q_Recommended (not always present)
These are all variable length depending on the data used to generate the report and the type of report generated (which is why 2 of them aren't always there).

That's all that I can think of. Let me know if I left out any explanations, and thanks a bunch for the help!
 




So what's the problem?

We have lots of tips for Excel and VBA, but I seriously doube that anyone will strain over some piece of code, especially without any supporting sample data, just to get you x fewer seconds of processing time to beat 30.

Have you inserted debug points to time your process?

You might check out the HPageBreaks collection: more efficient than looping thru rows.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
The only problem is that it is slow. I have inserted debug points and it seems that most of the time is spent in the creating of the array with the page_break values. I'll try the HPageBreaks collection that you mentioned and let you know how it goes.
 
Well I think I got it working well enough. I replaced the page_break lookup gode with the following, and it works like a champ now:
Code:
'get the row numbers of each page break
Names.Add "HPBreaks", "=GET.DOCUMENT(64)", False
page_break = [HPBreaks] 'so using evaluate to fill a variant array
ReDim Preserve page_break(UBound(page_break) + 2)
For i = UBound(page_break) - 1 To 1 Step -1
    page_break(i + 1) = page_break(i)
Next
page_break(1) = 0
page_break(UBound(page_break)) = Range("A65536").End(xlUp).Row
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top