Loop Search Text and cut/paste

This works but I don't know how to stop the loop (quit when it can't find "AR:") Thank you for any assistance

    Dim intRowCount As Integer
    intRowCount = Range("A1").CurrentRegion.Rows.Count - 1
  
 Do
     Cells.Find(What:="AR:", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(0, 1).Range("A1:H1").Select
    Selection.Cut
    ActiveCell.Offset(-1, 1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, -2).Range("A1").Select
    Cells.Find(What:="AR:", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Selection.EntireRow.Delete
End

End Sub