Excel VBA

Find and Delete

Option Explicit

Sub CleanUp()
    Dim LastRow     As Long
    Dim CurRow      As Long
    Dim daKey       As String
    Dim J, K
    daKey = "EVALUATION:"       'What to find
    On Error GoTo ErrHandler
    LastRow = ActiveCell.SpecialCells(xlLastCell).Row
    For J = 1 To LastRow
        With Sheets("Sheet1").Range("A:A")
        Range(Cells(J, 1), Cells(LastRow, 1)).Select
        Set K = .Find(What:=daKey, After:=.Range("A1"))    'Find it
        CurRow = K.Row     'Get the Row
        Range(Cells(CurRow, 1), Cells(CurRow + 5, 9)).Select           'Select row
        Selection.Delete    'Delete
        LastRow = LastRow - 6    'Reset end
        End With
    Next J
  Exit Sub
ErrHandler:
  MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error Some Place"
    
End Sub