Horizontal page breaks

Time to time someone asks for something like: "I have a lot of rows with data and I would like to have subtotals for each printed page. Is there a method how to do this?" It's not a problem to create the subtotals for the most of the users. But how to find page breaks? There are several methods which are less or more reliable. I want to show how to do this with Excel4Macro user defined function. What is a significant plus is that the height of rows don't have to be the same or the rows can be hidden.

Create XLM function

At first you have to add International Macro Sheet. This is a better way than MS Excel 4.0 Macro, because you don't need to translate functions. Just copy and paste. ;)
Copy following rows to the first cell in this sheet.

Select all

=RESULT(64)
=RETURN(GET.DOCUMENT(64))

RESULT(64) - specifies that the result of this function is an array. If this row is omitted then only a row number of the first page break is returned.
GET.DOCUMENT(64) - an array of row numbers corresponding to rows that are immediately below a manual or automatic page break.

Hide this sheet.

VBA code

Perhaps it would be possible to write a function completely in the XLM language. However, using of VBA is much more comfortable. There is no difference whether the macro is XLM or VBA. In both cases you have to save it as macro-enabled (xlsm).
In VBA you can get the result of the XLM function by this way:

Select all

Application.Run("Macro1!A1")

There are two possibilities how to use the function on a worksheet.

VBA UDF

You can write user defined function, e.g.:

Select all

Function HORIZONTAL_PB(iRow As Long) As Boolean
  Application.Volatile
  HORIZONTAL_PB = ";" & Join(Application.Run("Macro1!A1"), ";") & ";" Like "*;" & iRow & ";*"
End Function

In a worksheet:
for check if there is a page break on the row insert

Select all

=HORIZONTAL_PB(ROW())

or for check if the row is last on a page insert

Select all

=HORIZONTAL_PB(ROW()+1)

and copy it to each row in the print area. Every time the sheet is recalculated the UDF checks if there is a page break in the row (TRUE) or is not (FALSE). But this possibility is very slow.

VBA subroutine

Using of VBA subroutine is much more quicker. It can be called by the BeforePrint event or by clicking on a button.

Select all

Sub subActualizeHPBs()
  Const sCOLUMN As String = "C:C"
  
  Dim iCalc As Long
  iCalc = Application.Calculation
  Application.Calculation = xlCalculationManual
  
  Range(sCOLUMN).ClearContents
  
  Dim rHPBs As Range
  
  Dim vVal As Variant
  For Each vVal In Application.Run("Macro1!A1")
    If rHPBs Is Nothing Then
      Set rHPBs = ActiveSheet.Rows(vVal - 1)
    Else
      Set rHPBs = Union(rHPBs, ActiveSheet.Rows(vVal - 1))
    End If
  Next vVal
  
  If Not rHPBs Is Nothing Then
    Intersect(Range(sCOLUMN), rHPBs).Value = True
    Set rHPBs = Nothing
  End If
  
  Application.Calculation = iCalc
End Sub

You can download the workbook here: PageBreaks.xlsm 

Tweet