PageBreak, AutoFilter, SpecialCells

[Philcjr]

Looking for some help here, I have a file in which I track my monthly credit card charges. I would like to be able to have the option to print on one page each monthly billing cyle. I already have the code to insert the PageBreaks but do not know how to make it so that the information between page breaks fits on one page.

Here is the code I have for inserting the PageBreaks where I need them... this code, to me, seems to run rather slowly, any tweaks here?


Sub PageBreakCreate()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Charges")
Dim LastRow As Long: Let LastRow = ws.Range("C65536").End(xlUp).Row
Dim rCell As Range

Call Tools.SettingsOff

With ws
.ResetAllPageBreaks
.PageSetup.PrintArea = "A:G"
.PageSetup.PrintTitleRows = "$1:$1"
.Range("A1").AutoFilter Field:=4, Criteria1:="=PURCHASE*"

For Each rCell In .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
On Error Resume Next
rCell.Rows.Offset(1, 0).PageBreak = xlPageBreakManual
On Error GoTo 0
Next rCell

.Range("A1").AutoFilter

End With

Call Tools.SettingsOn

End Sub

[p45cal]

Try (adjust MaxLineCount to suit)Sub PageBreakCreate2()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Charges")
Dim LastRow As Long: Let LastRow = ws.Range("C65536").End(xlUp).Row
Dim rCell As Range
Dim LineCount As Long, MaxLineCount As Long
Call Tools.SettingsOff
LineCount = 0: MaxLineCount = 10
With ws
.ResetAllPageBreaks
.PageSetup.PrintArea = "A:G"
.PageSetup.PrintTitleRows = "$1:$1"
For Each rCell In .Range("A2:A" & LastRow)
If InStr(UCase(rCell.Offset(, 3).Value), "PURCHASE") > 0 Or LineCount >= MaxLineCount Then
rCell.Rows.Offset(1, 0).PageBreak = xlPageBreakManual
LineCount = 0
End If
LineCount = LineCount + 1
Next rCell
End With
Call Tools.SettingsOn
End Sub
ps the line:
If InStr(UCase(rCell.Offset(, 3).Value), "PURCHASE") > 0 Or LineCount >= MaxLineCount Then
might be better changed to
If InStr(UCase(rCell.Offset(, 3).Value), "PURCHASE") =1 Or LineCount >= MaxLineCount Then
to reflect more accurately your original filter criterion.

[Philcjr]

Using the AutoFilter approach it took 5.640 seconds
Using the Instr approach it took 5.421 seconds.... thanks p45cal

I am still looking to try and figure out a way to have all the charges for a given month forced to print on one page, regaurdless if there are 10 charges or 80 for the month... 1 row = 1 charge

I am going to try and play around with this tonight, I am open to any suggetions people might have.

Thanks,
Phil

[p45cal]

I misunderstood - oops. Try the following (I've lost your Tools.Settings lines 'cos I don't know what they do. You might want to substitute direct printing instead of my PrintPreview line.):Sub PageBreakCreate3()
Dim RowNos()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Charges")
Dim LastRow As Long: LastRow = ws.Range("C65536").End(xlUp).Row
Dim rCell As Range
ReDim RowNos(1 To 1): RowNos(1) = 1
With ws
.ResetAllPageBreaks
.PageSetup.PrintTitleRows = "$1:$1"
For Each rCell In .Range("D2:D" & LastRow)
If InStr(Ucase(rCell.Value), "PURCHASE") = 1 Then
ReDim Preserve RowNos(1 To UBound(RowNos) + 1)
RowNos(UBound(RowNos)) = rCell.Row
End If
Next rCell
If RowNos(UBound(RowNos)) <> LastRow Then
ReDim Preserve RowNos(1 To UBound(RowNos) + 1)
RowNos(UBound(RowNos)) = LastRow
End If
For rw = 1 To UBound(RowNos) - 1
.PageSetup.PrintArea = Range(.Cells(RowNos(rw) + 1, 1), .Cells(RowNos(rw + 1), 7)).Address
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintPreview
Next rw
End With
End Sub
I wasn't concerned about timing, more about functionality, though page setup code is well known for taking a long time sometimes.

[Philcjr]

p45cal.... THANK YOU. I wanted to play around lastnight with this but my wife decided to update her IPhone and had some major issues... I will play with this and let you know how it works out... this seems to be exactly what I was after.