Excel Forum

Code: Select all

Sub Macro1()
   On Error Resume Next
    With Sheets("Sheet1").Range("a1:a100")
        Set c = .Find(What:="12345", After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
            firstaddr = c.Address
            Do
                c.Value = ""
                Set c = Cells.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstaddr
        End If
    End With
    Sheets("Sheet1").Range("a1:a100").SpecialCells( _
        xlCellTypeBlanks).EntireRow.Delete
End Sub