Conditional Page Breaks

[andy]

Someone must have already encountered this and written
code. Please help me with this. A macro (I'll put a menu
button on the tool bar) will be fine.

In one single column (e.g. A) I would like the code to
look at a cell (e.g. beginning with B10) and compare the
value in B10 to the value directly below it (B11). If it
is different I would like a page break to be inserted. If
it is the same, the code should move on (compare B11 to
B12...).
It would be like programmatically inserting page breaks
at "group by" levels.

Some things to overcome:
1)Empty cells should be ignored (no page break just
because the previous cell had values and the active cell
is blank).
2) Also all cells with text letters should be ignored
(again no page break just because it is different)

A second macro to remove all page breaks (get ready for
the next set of data) would be very helpful too.

Here is an exampele with data and actions I would like:

A1 100101
A2 100101 no change (A1 = A2)
A3 100101
A4 200222 insert page break (A3 <> A4)
A5 200501 insert page break (A4 <> A5)
A6 200501
A7 200501
A8 no change (blank line)
A9 no change (blank line)
A10 Sales division: no change (text in cells)
A11 300101 insert page break (A7 <> A11)
A12 300101
A13 300501 insert page break (A12 <> A13)

Thank you in advance
God bless you

 

[Frank Kabel]

Hi andy
try the following two macros:

Option Explicit
Sub insert_pagebreak()
Dim lastrow As Long
Dim row_index As Long

lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).row
For row_index = lastrow - 1 To 10 Step -1
If Cells(row_index, "B").Value <> "" Then
If IsNumeric(Cells(row_index, "B").Value) Then
If Cells(row_index, "B").Value <> _
Cells(row_index + 1, "B").Value Then
ActiveSheet.HPageBreaks.Add Before:= _
Cells(row_index + 1, "B")
End If
End If
End If
Next
End Sub

Sub remove_them()
ActiveSheet.ResetAllPageBreaks
End Sub

 

[andy]

Hi Frank,

Thank you so very much for your reply. I first tried the
macros with my limited test data, and all worked very
well. However, the real data has almost 10,000 rows. When
I ran the macro against the full data it gave me an "Out
of Memory" dialog box, and when I debug the code, it had
stopped at the following:

ActiveSheet.HPageBreaks.Add Before:= _
Cells(row_index + 1, "B")

I have a powerful computer with 524MB ram, and I don't see
why this would happen. If I take about 3,000 rows at a
time it works well, but not all 10,000.
Is there a way to perhaps break up the code in subs to do
3,000 at a time? Will that work around the memory problem?

Thank you in advance for all your help
God bless you

 

[Frank Kabel]

Hi
never tested that
Could be that Excel does not allow that much pagebreaks in one sheet.
You may try the following:
Change the line
For row_index = lastrow - 1 To 10 Step -1

to
For row_index = 10000 To 5000 Step -1
run the macro and change the line again e.g. to
For row_index = 5000-1To 3000 Step -1

and repeat this. This may help