Insert page breaks if a cell contains trigger words

[barleyhill]

Hi all,

Please refer to the following link. Insert a page break if after a cell if it contains either scenario?

I wish to insert page breaks in column B, if any cell contains certain words amongst all the text.

For example a cell may contain 50+ words, but if the words "Forward to summary" or "To collection" are found within the cell, insert a page break after the cell.

Thanks.

 

[GRTorres]

Hi barleyhill,

Would the page break keep inserting at Column B if found multiple criteria? Meaning, only data is in Column A and will continue down the list until completed?

Thanks.

 

[GRTorres]

Assuming there is only data in Column a with text strings the following macro will work:

Sub PageBreak()

Set a = Sheets("Sheet1")
Dim b As Integer
b = 1

Do Until IsEmpty(a.Range("A" & b))

If InStr(1, a.Range("A" & b), "to collection") > 0 Then
Sheets("Sheet1").Columns("B").PageBreak = xlPageBreakManual
End If

b = b + 1
Loop

End Sub

 

[barleyhill]

Hi GR Torres,

Yes, there is text in other columns.

I have got some help with this recently. The below macro inserts a page break below a cell if it encounters "To Collection", however it does not insert a page break if it finds "Forward to summary" as there is other text in the cell... eg (Forward to Summary of Bill No. 5)

Effectively this what i want explained in an excel formula!!
IF(ISNUMBER(SEARCH({"to collection" or "forward to summary"},in column B)),"insert a page break below the active cell,"")



Sub PageBreaks()
Dim rng As Range
Dim ws As Worksheet
Dim i As Long, j As Long
Dim LR As Long

Set ws = Sheets("111")
ws.ResetAllPageBreaks
LR = Range("B65536").End(xlUp).Row
Set rng = ws.Range("B3:B" & LR) ' from row 3
rng.Offset(0, -1).ClearContents




i = 0
j = 0


For Each r In rng


If r.Value = "To Collection" Or r.Value = "Forward to Summary" Then
j = 0
i = i + 1
ws.HPageBreaks.Add Before:=r.Offset(1)
Set ws.HPageBreaks(i).Location = r.Offset(1)
Else
If r.Offset(0, 1).Value <> "" Then
r.Offset(0, -1) = Chr(65 + j)
j = j + 1
End If
End If
Next r


With ws.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1 ' use this if this is desired as well
End With


End Sub