Dynamic Header or Footer
Dynamic Header or Footer
Dynamic Header or Footer

In Excel you can create a header or footer which includes dynamic data such as the pagenumber or date. However, there is no intrinsic function available to add a subtotal for example. This article shows a method for achieving such. It will calculate the subtotal and grand total for a series of numbers and display them in the footer of each page.

How it works

Excel can not store different footers or headers for different pages. So the idea is dynamically generate a header or footer for each page just before printing it. Then change the footer or header again for the next page, and so on.

To do that we use HPageBreaks collection that holds all the HPageBreak objects. The HPageBreak objects are all the page ends. The Location property of each HPageBreak object returns the cell (Range object) where a page ends.

By looping through all the HPageBreak objects we can set the page properties like header and footer just before printing it out.

Code

Sub PrintDynamicFooterHeader()
    'This routine prints pages with a running total of column D.
    'Rembo created this routine.    
    Dim rPrint() As Range, rStartCell As Range, rEndCell As Range, r As Range
    Dim i As Integer, iHPagebrks As Integer
    Dim dblGrandTotal As Double, dblSubTotal As Double
 
    'Set PrintArea to used range
    Worksheets(1).PageSetup.PrintArea = Worksheets(1).UsedRange.Address
 
    'There is an issue with the HPageBreaks and VPageBreaks collection in Excel that
    'under certain circumstances causes not all the Breaks being correctly identified
    'and added to the collection.
    'More info at http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
    'This part of the code is here to circumvent that issue.
    '
    'Select the last cell in your used range
    With Worksheets(1)
        .Cells(.UsedRange.Rows.Count + .UsedRange.Row - 1, _
               .UsedRange.Columns.Count + .UsedRange.Column - 1).Select
    End With
 
    'Turn off screenupdating to improve processing speed
    Application.ScreenUpdating = False
 
    iHPagebrks = Worksheets(1).HPageBreaks.Count
 
    'Determine and store ranges to print
    'We include columns A to D
    ReDim rPrint(iHPagebrks + 1)
    For i = 1 To iHPagebrks + 1
        With Worksheets(1)
            If i = 1 Then
                Set rEndCell = .HPageBreaks(i).Location.Offset(-1, 4)
                Set rStartCell = .UsedRange.Item(1, 1)
            ElseIf i = iHPagebrks + 1 Then
                Set rEndCell = .Cells(.Rows.Count, _
                          .HPageBreaks(i - 1).Location.Column).End(xlUp).Offset(0, 4)
                Set rStartCell = .Cells(.HPageBreaks(i - 1).Location.Row, 1)
            Else
                Set rEndCell = .HPageBreaks(i).Location.Offset(-1, 4)
                Set rStartCell = .HPageBreaks(i - 1).Location
            End If
            rEndCell.Activate
        End With
        Set rPrint(i) = Range(rStartCell, rEndCell)
    Next i
 
    'Preview each page to print and count the subtotal and grand total for column D.
    'To actually print, replace the PrintPreview method with the PrintOut method.
    For i = 1 To UBound(rPrint)
        dblSubTotal = Application.WorksheetFunction.Sum(rPrint(i).Columns(4))
        dblGrandTotal = dblGrandTotal + dblSubTotal
        With Worksheets(1).PageSetup
            .PrintArea = rPrint(i).Address
            .LeftFooter = "Page " & i
            .RightFooter = "Sub Total: " & dblSubTotal & Chr(13) & _
                           "Grand Total: " & dblGrandTotal
        End With
        ActiveWindow.SelectedSheets.PrintPreview
    Next i
 
    'Clean up
    Worksheets(1).PageSetup.RightFooter = ""
 
    'Turn on screenupdating back on
    Application.ScreenUpdating = True
 End Sub

Remarks

As you can see in the code above there is a known issue with pagebreaks in Excel. Under certain conditions you could receive a “Subscript out of range” error message. To prevent this problem, add code to select the last cell used in the worksheet before the code uses the Location property of horizontal or vertical page breaks.

Please note that the HPageBreak object depends on the page settings like margins and scale. If you would set the page number in the footer using the build in method to set the footer text it would return ‘Page 1’ on every printout. That is why you should also hard code the page number in the footer. In the above example this is done by setting the LeftFooter to the string “Page” and the loop counter.

There is a limit of 1026 horizontal page breaks per sheet.

 


Courtesy: vba & excel – rambo

Leave a Reply

Your email address will not be published. Required fields are marked *

20 + fourteen =

This site uses Akismet to reduce spam. Learn how your comment data is processed.