Find specific cell and insert page break - repeat till end of sheet

[Cubajz]

Hi,
I have this code which is not ideal:



Sub Find_cell_and_insert_HPageBreak ()
Selection.Find(What:="Příloha č.", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate


If ActiveCell.EntireRow.Hidden Then
GoTo NEXT1
Else
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
NEXT1:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
Selection.Find(What:="Příloha č.", After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate


If ActiveCell.EntireRow.Hidden Then
GoTo NEXT2
Else
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
NEXT2:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
End Sub



I continue with this into something like NEXT50: ...Can someone please help me to make this more sophisticated (its also slow: pray2:). Thank you:yes

[mancubus]

assuming the text to be found is in Column 1 / Column A



Sub vbax_95347_insert_hpb_at_each_cell_with_specific_text()


Dim i As Long
Dim LastRow As Long

With Worksheets("Sheet1") 'change Sheet1 to suit
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

For i = 1 To LastRow
If .Cells(i, 1).Value Like "SearchText" Then 'change SearchText to suit
.HPageBreaks.Add Before:=.Rows(i)
End If
Next
End With


End Sub

[p45cal]

Cunajz's code is dependent on the selection before it is run. So is this:
Sub Find_cell_and_insert_HPageBreak()
Dim rng As Range

With Selection
Set rng = .Find(What:="Příloha č.", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
If Not rng.EntireRow.Hidden Then ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=rng
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> firstAddress
End If
End With
End Sub


Another way to avoid hidden cells is to get .Find to ignore them using LookIn:=xlValues instead of LookIn:=xlFormulas:

Sub Find_cell_and_insert_HPageBreak()
Dim rng As Range

With Selection
Set rng = .Find(What:="Príloha c.", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=rng
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> firstAddress
End If
End With
End Sub