excel macro page break

[KC Rippstein hotmail com>]

I have a worksheet with a formatted pivot table (using auto report #6) ready
for printing.

The pivot table has clients listed in the row area (with subtotals first),
so the client's name shows up in column A. Then I have separate divisions
listed as subitems in the row area, and those show up in column B directly
underneath each respective client. There is a blank row between the end of a
client's info and the next client's name.

When I go to print, it would be very helpful to have Excel evaluate whether
a page break is in the middle of a client's data and move the page break to
just before that client's name so their data does not get broken up over 2
pages. I suppose the macro would need to perform three tasks:
1) reset all page breaks (easy part)
2) search for the next page break (??) and do the following:
a) if the next row (which would become the first row on the next page)
has a value in column B, then move UP column B to the next blank row and
insert a forced page break above that row (this should also reset all the
automatic breaks thereafter)
b) otherwise leave the auto page break where it is
3) repeat step 2 until the end of the sheet is reached

Right now, we do all this manually. We have 6 page field items, so I take
the 3 to 5 minutes needed to get all the page breaks right, print, and reset
all page breaks a total of 6 times, consuming a half hour overall. This is
certainly not an efficient use of time, so I am hoping someone knows how to
program this.

Here is my humble attempt so far, which does the job correctly once but then
does not advance down the worksheet. I think once I set a manual page break,
it messes up my For...Next loop because all the other auto-page breaks
following are reassigned??

'==================
Sub FormatPageBreaks()
Dim oHPgbr As HPageBreak
Dim iRow As Long

ActiveSheet.ResetAllPageBreaks

On Error Resume Next
For Each oHPgbr In ActiveSheet.HPageBreaks
iRow = oHPgbr.Location.Row
If Cells(iRow, "B").Value = "" Then
Else
Do Until Cells(iRow, "B").Value = ""
iRow = iRow - 1
Loop
Rows(iRow).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
Next
End Sub

 

[KC Rippstein hotmail com>]

I figured this out with some excellent guidance from Earl Kiosterud. Thanks,
Earl!!

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Const ColumnKey = 2 ' Key column for groups
Dim HCtr As Double
Dim i As Integer, j As Integer
Dim lRow As Long

ActiveSheet.ResetAllPageBreaks
HCtr = 0 ' Total row height accumulator for page
i = 1 ' row counter
lRow = Cells(Rows.Count, 1).End(xlUp).Row ' last row
Do While i < lRow
HCtr = HCtr + Rows(i).Height ' accumulate height
i = i + 1 ' next row
If HCtr > 450 Then ' landscape vertical height max
For j = i To 0 Step -1 ' go back through rows
If Cells(i, ColumnKey).Value = "" Then Exit For
' at beginning of group, found a break, get out
i = i - 1 ' otherwise move up to previous row
Next j ' and reevaluate
ActiveWindow.SelectedSheets.HPageBreaks.Add _
Before:=Cells(i, ColumnKey).EntireRow
HCtr = 0
End If ' HCtr
Loop
End Sub