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.
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
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