VB code to insert page breaks for Duplex/double-sided Printing

[dl]

As some may know when you print a large list of data double-sided, and there
are lists within the data that should go to different parties, excel doesn't
offer the fix Word has -section breaks. So the 2nd set of data ends up on
the back of a page that has the 1st set of data on the front.

For example:
STORE# DATA DATA page orientation
1 x x -front of page 1
1 x x -back of page 1
1 x x -front of page 2
2 x x -back of page 2 <- this is the
problem
2 x x ...

To fix this I've been trying to write some VB to look for a change in column
A and where the current page number is odd. When the situation is found it
would insert a blank row and a page break on either side of the blank row,
which effectively would put a blank page on the back of a data set that ended
on the front of a page. Fixing the problem above. Unfortunately I'm pretty
new to VB and can't seem to find out where my problem is.

The error I'm having now is: Run-time error 91 Object variable or With block
variable not set

The code:
Sub FixDuplexPrinting()

'''Adjust page breaks for duplex printing'''

Dim HPageBreaks As HPageBreaks

'set focus
Range("A1").Select

'move down one cell
ActiveCell.Offset(1).Select

'loop down column A comparing cell above focus looking for change in
value (store number)
'when change is found and the current page # is odd, insert a page break
'then insert a blank row and insert another page break above the blank row
'so that store data never shares a page (on double-sided / duplex
printing)

Do Until IsEmpty(ActiveCell.Value) = True
If ActiveCell.Value <> ActiveCell.Offset(-1).Value And
HPageBreaks.Count Mod 2 = 1 Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Selection.Insert Shift:=xlDown
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
ActiveCell.Offset(1).Select

'if there isn't a change continue checking
Else
ActiveCell.Offset(1).Select

End If
Loop
End Sub

Any help is GREATLY appreciated, thank you!!!

 

[keiji kounoike]

I'm not sure this would work or not, but try this one. I assume your
data start at second row(the number of row is 2), the first row is a
header and the count of rows in a page is 5, not including header rows.
if this is not the case, you have to change each numbers in the code.

Sub testMacro()
Const rows_in_page = 5 '<<==a count of rows in a page
Dim lastcell As Range, startcell As Range, endcell As Range
Dim startnum As Long
Dim pagenum As Long

startnum = 2 'a starting row's number following a header
pagenum = 1 'a page number

ActiveWindow.View = xlPageBreakPreview
Set lastcell = Cells(Rows.Count, "A").End(xlUp)
ActiveSheet.ResetAllPageBreaks
Set startcell = Cells(startnum, "A")
Set endcell = startcell.Offset(1, 0)

With ActiveSheet
Do While (startcell.Row <= lastcell.Row)
If (endcell.Row - startcell.Row + 1) > rows_in_page Then
.HPageBreaks.Add Before:=endcell
Set startcell = endcell
Set endcell = startcell.Offset(1, 0)
pagenum = pagenum + 1
If startcell.Value <> startcell.Offset(-1, 0).Value _
And pagenum Mod 2 = 0 Then
startcell.EntireRow.Insert
.HPageBreaks.Add Before:=startcell.Offset(-1, 0)
pagenum = pagenum + 1
End If
ElseIf startcell.Value <> endcell.Value Then
If pagenum Mod 2 = 0 Then
endcell.EntireRow.Insert
.HPageBreaks.Add Before:=endcell
Set startcell = endcell
Set endcell = startcell.Offset(1, 0)
pagenum = pagenum + 1
Else
.HPageBreaks.Add Before:=endcell
Set startcell = endcell
Set endcell = endcell.Offset(1, 0)
pagenum = pagenum + 1
If startcell.Value <> startcell.Offset(-1, 0).Value _
And pagenum Mod 2 = 0 Then
startcell.EntireRow.Insert
.HPageBreaks.Add Before:=startcell.Offset(-1, 0)
pagenum = pagenum + 1
End If
End If
Else
Set endcell = endcell.Offset(1, 0)
End If
Loop
End With
End Sub

Keiji

 

[dl]

Hi Keiji,
Thank you VERY much for taking the time to help me out. I tried the code
and it seems to work until at some point it inserts a blank row to
accommodate the next page, but doesn't insert a page break above the blank
line. I'd really appreciate it if you could take a look at it. As you may
have noticed I'm still trying to teach myself VB, so if you don't have time
to test this more would you mind inserting comments on each line to explain
what you did so I can attempt to adjust it?

Thanks again for your help!!!!
Darren

 

[keiji kounoike]

Hi dl

I tested my code with a small sample, so i couldn't find what's wrong
with my code. If you don't mind, Please send me your data and tested
code. I'll check it in my side. My e-mail address is kounoike at
mbh.nifty.com. Just change at to @.

Regards
keiji

 

[dl]

THANK YOU KEIJI!!!!

The code works beautifully. All you have to do was enter your paper type,
what row the data starts on and desired margins -and viola!

Keiji put this together in no time, and my IT dept said it wasn't possible.
ha

 

[keiji kounoike]

Hi dl

Thanks for feedback. I'm glad it has been any help to you.

Keiji