Search and replace page break (Office 2003)

Topic

New Reply

I need to search for text in COL A of an excel file and find “MEAN” and put a page break after those instances. How can I turn the below recorded macro into a loop that search through the whole file? Thank you for the help.

Cells.Find(What:=”MEAN”, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Rows(“21:21”).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Selection.FindNext(After:=ActiveCell).Activate

Reply | Quote

Replies

Try this:

Sub InsertPageBreaks()
Dim c As Range
Dim firstAddress As String
With ActiveSheet.Cells
Set c = .Find(“MEAN”, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
ActiveSheet.HPageBreaks.Add Before:=c.Offset(1, 0)
Set c = .FindNext©
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
End Sub

Reply | Quote

Thanks very much. That works great.

Now I am trying to change it to format 3 rows of headers that appear throughout the file. The properly formatted rows are 5:7. I want to search for the word TOTAL in B25-B500 and format the row above and below the found row like rows 5:7.

Have tried this…

Dim rngTC As Range
Dim rngCell As Range

Range(“A1”).Select
On Error Resume Next
Set rngTC = ActiveSheet.Columns(“B25:B500”).SpecialCells(xlCellTypeConstants, 2)

If Not rngTC Is Nothing Then
For Each rngCell In rngTC
If InStr(1, rngCell.Value, “TOTAL”, vbTextCompare) > 0 Then
rngCell.Select

Rows(“5:7”).Select
Selection.Copy
rngCell.EntireRow.Offset(-1, 0).Rows(3).Select
Selection.PasteSpecial Paste:=xlPasteFormats
End If
Next rngCell
End If

Reply | Quote

Why not use code similar to that in my previous reply?

Dim c As Range
Dim firstAddress As String
With ActiveSheet.Range(“B25:B500”)
Set c = .Find(“Total”, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(“5:7”).Copy
Range(c.Offset(-1, 0), c.Offset(1, 0)).EntireRow.PasteSpecial xlPasteFormats
Set c = .FindNext©
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With

Reply | Quote