Find keyword and delete the rows below and above

Hi, zeroist,

if the keywords aren´t found on the sheet that´s the normal way with teh code as it was supplied. Just change the position of the If-Statement that raisees the error, and the code will run through nicely (well, at least not raising any errors on testing):

The calling procedure will remain unchanged and just get a higher version number

Sub EF953570_4a()
'will call procedure and hand over item to search, delete either the first ccurrance and every row including Found above (1)
'or last Found and below (2)
Call SearchItemsInWorkbook("ringtone to your cell", 2)
Call SearchItemsInWorkbook("there is no guarentee", 1)
End Sub

Sub SearchItemsInWorkbook(strSearch As String, lngFirst As Long)
' strSearch: item to search for as part of the cells
' lngFirst:  1 deletes the first occurrance of the item and all cells above
'            2 deletes the last occurrance of the item

Dim wsTab As Worksheet
Dim rngCell As Range
Dim rngDelete As Range
Dim strAddress As String
Dim strTempAdr As String
Dim blnLoopOn As Boolean
Dim blnFirst As Boolean

If lngFirst < 1 And lngFirst > 2 Then
  MsgBox "Value for parameter of what to delete is out of range available (must be 0 for all, 1 for first, 2 for last)!"
  Exit Sub
End If

For Each wsTab In ActiveWorkbook.Worksheets
  blnLoopOn = True
  Set rngCell = wsTab.Cells.Find(what:=strSearch, lookAt:=xlPart)
  If Not rngCell Is Nothing Then
    Set rngDelete = rngCell
    If lngFirst = 1 Then
      Set rngDelete = Union(rngDelete, wsTab.Cells(1, 1).Resize(rngCell.Row))
    Else
      strAddress = rngCell.Address
      Do While blnLoopOn
        Set rngCell = wsTab.Cells.FindNext(After:=rngCell)
        blnLoopOn = rngCell.Address <> strAddress
        If Not rngCell Is Nothing And rngCell.Address <> strAddress Then
          strTempAdr = rngCell.Address
          Set rngDelete = Union(rngDelete, rngCell)
        Else
          blnLoopOn = False
        End If
      Loop
    End If
    If lngFirst = 2 Then
      If Len(strTempAdr) > 0 Then
        Set rngDelete = wsTab.Range(wsTab.Range(strTempAdr), wsTab.Range("A" & Rows.Count).End(xlUp))
      Else
        Set rngDelete = wsTab.Range(rngDelete, wsTab.Range("A" & Rows.Count).End(xlUp))
      End If
    End If
  End If
  If Not rngDelete Is Nothing Then
    rngDelete.EntireRow.Delete
  End If
  Set rngDelete = Nothing
Next wsTab

Set rngCell = Nothing

End Sub

Ciao,
Holger