Find keyword and delete the rows below and above

Hi, zeroist,

I know you are getting angry with me,but one more help,

I prefer to answer to threads where the original request remains the same throughout as the concept was developed on hte first post (which is reverted withthe last request).

This is the code for the whole module in one code block:

Option Explicit

Dim mblnDelete As Boolean


Sub EF953570_5()
'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)
Dim wsTab As Worksheet

For Each wsTab In Worksheets
  mblnDelete = False
  Call SearchItemsInWorkbook(wsTab.Name, "ringtone to your cell", 2)
  Call SearchItemsInWorkbook(wsTab.Name, "there is no guarentee", 1)
  If mblnDelete Then
    Application.DisplayAlerts = False
    wsTab.Delete
    Application.DisplayAlerts = True
  End If
Next wsTab


End Sub
Sub SearchItemsInWorkbook(strSheet As String, 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 rngCell As Range
Dim rngDelete As Range
Dim strAddress As String
Dim strTempAdr As String
Dim blnLoopOn As Boolean
Dim blnFirst As Boolean
Dim wsWork As Worksheet

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

Set wsWork = Sheets(strSheet)
blnLoopOn = True
Set rngCell = wsWork.Cells.Find(what:=strSearch, lookAt:=xlPart)
If Not rngCell Is Nothing Then
  Set rngDelete = rngCell
  If lngFirst = 1 Then
    Set rngDelete = Union(rngDelete, wsWork.Cells(1, 1).Resize(rngCell.Row))
  Else
    strAddress = rngCell.Address
    Do While blnLoopOn
      Set rngCell = wsWork.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 = wsWork.Range(wsWork.Range(strTempAdr), wsWork.Range("A" & Rows.Count).End(xlUp))
    Else
      Set rngDelete = wsWork.Range(rngDelete, wsWork.Range("A" & Rows.Count).End(xlUp))
    End If
  End If
Else
  mblnDelete = True
End If
If Not rngDelete Is Nothing Then
  rngDelete.EntireRow.Delete
End If
Set rngDelete = Nothing

Set rngCell = Nothing

Set wsWork = Nothing

End Sub

Ciao,
Holger