Insert Page Break Based on Text

[ryguy7272]

I got stuck on something pretty easy, I think. I am trying to set the print
area from Column B to Column J. Also, I want to add three page breaks, one
after "LIMIT:", one after "Standard:", and one after "e-mail:" – notice AFTER
email, not before. The macro posted below kind of works, but it is
inconsistent, at best. I want only Columns B:J printed. Also, some data
will be added and some will be deleted, so the number of rows will change a
bit – nothing too drastic. It seems like the print preview shows spaces that
are too small sometimes. Is there a way to maximize the print area, and then
insert the three page breaks based on the criteria mentioned above?

Private Sub CommandButton3_Click()
Sheets("Primary Letter").Select
Sheets("Primary Letter").Activate
ActiveSheet.ResetAllPageBreaks


lngLastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
For lngRow = 1 To lngLastRow
If Range("B" & lngRow) = "LIMIT:" Then
Sheets("Primary Letter").HPageBreaks.Add Before:=Range("B" & lngRow)
End If

If Range("B" & lngRow) = "Standard:" Then
Sheets("Primary Letter").HPageBreaks.Add Before:=Range("B" & lngRow)
End If

If Range("B" & lngRow) = "e-mail:" Then
ActiveCell.Offset(1, 0).Select
Sheets("Primary Letter").HPageBreaks.Add Before:=Range("B" & lngRow)
End If

ActiveSheet.PageSetup.PrintArea = "$B:$J"

Next
End Sub

TIA,
Ryan---

 

[Jacob Skaria]

Use the object model....

Private Sub CommandButton3_Click()
Dim ws As Worksheet, varFound As Range
Dim arrSearch As Variant, intTemp As Integer

Set ws = Sheets("Primary Letter")
arrSearch = Array("LIMIT:", "Standard:", "e-mail:")

ws.PageSetup.PrintArea = ""
ws.PageSetup.PrintArea = "$B:$J"
ws.ResetAllPageBreaks

For intTemp = 0 To UBound(arrSearch)
Set varFound = ws.Columns(2).Find(arrSearch(intTemp), , xlValues, 1)
If Not varFound Is Nothing Then
ws.HPageBreaks.Add Before:=ws.Range("B" & varFound.Row + 1)
End If
Next
End Sub

If this post helps click Yes

 

[ryguy7272]

Thanks, Jacob, but this seems to go only from B to H. I wanted B to J.
Also, the page breaks don’t occur at the places I wanted; ‘LIMIT OF
LIABILITY:’ and ‘Standard Terms and Conditions:’ and ‘e-mail:’. Any other
ideas?

Thanks,
Ryan--

 

[Jacob Skaria]

The earlier version searched for an whole cell match..Changed that to part..

Sub Macro()

Dim ws As Worksheet, varFound As Range
Dim arrSearch As Variant, intTemp As Integer

Set ws = Sheets("Primary Letter")
arrSearch = Array("LIABILITY:", "Conditions:", "e-mail:")

ws.PageSetup.PrintArea = ""
ws.PageSetup.PrintArea = "$B:$J"
ws.ResetAllPageBreaks

For intTemp = 0 To UBound(arrSearch)
Set varFound = ws.Columns(2).Find(arrSearch(intTemp), , xlValues, xlPart)
If Not varFound Is Nothing Then
ws.HPageBreaks.Add Before:=ws.Range("B" & varFound.Row + 1)
End If
Next

End Sub

If this post helps click Yes

 

[Jacob Skaria]

If the columns are wide enough to create the auto vertical page break; then
add the below code to the end so as adjust the zoom ...to fit it to 1 page
wide.

With ws.PageSetup
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = 85
End With

If this post helps click Yes

 

[ryguy7272]

That did it! The zoom trick is cool. I've used it before, but forgot about
it until you reminded me about it today.

Thanks so much!!
Ryan--