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

Hi,
I have this code which is not ideal:

Code:

---

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

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

Code:

---

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

---

Cunajz's code is dependent on the selection before it is run. So is this:

Code:

---

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:

Code:

---

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

---