Find keyword and delete the rows below and above

Hi, zeroist,

I used two codes in my attempt to solve your problem. The first features the items you will search for as well as the number of rows to delete above and/or below the found item and a boolean to decide whether to delete or "paint" the area (we could add another parameter for the colour but I choose yellow here).

Sub EF953570()
'will call procedure and hand over item to serach, the number of rows above (eneterd asp positive number) as
'well as number of rows below found to delete and advise to delete or just color
Call SearchItemsInWorkbook("ringtone to your cell", 1, 1, False)    'will color all cells
Call SearchItemsInWorkbook("there is no guarentee", 2, 0, True)     'will delete all cells
End Sub

The second will loop through all worksheets and do accordingly:

Sub SearchItemsInWorkbook(strSearch As String, lngOffNeg As Long, lngOffPos As Long, blnDelete As Boolean)
' strSearch: item to search for as part of teh cells
' lngOffNeg: number of rows above the found cell to be deleted, should be entered as positiv number!
' lngOffPos: number of rows below the found cell to be deleted, should be entered as positiv number!

Dim wsTab As Worksheet
Dim rngCell As Range
Dim rngDelete As Range
Dim strAddress As String

For Each wsTab In ActiveWorkbook.Worksheets
  Set rngCell = wsTab.Cells.Find(what:=strSearch, lookAt:=xlPart)
  If Not rngCell Is Nothing Then
    strAddress = rngCell.Address
    Do
      If rngDelete Is Nothing Then
        Set rngDelete = rngCell.Offset(-lngOffNeg, 0).Resize(lngOffNeg + 1)
        Set rngDelete = Union(rngDelete, rngCell.Offset(lngOffPos, 0))
      Else
        Set rngDelete = Union(rngDelete, rngCell.Offset(-lngOffNeg, 0).Resize(lngOffNeg + 1))
        Set rngDelete = Union(rngDelete, rngCell.Offset(lngOffPos, 0))
      End If
      Set rngCell = wsTab.Cells.FindNext(After:=rngCell)
    Loop While rngCell.Address <> strAddress
  End If
  If Not rngDelete Is Nothing Then
    If blnDelete Then
      rngDelete.EntireRow.Delete
    Else
      rngDelete.Interior.ColorIndex = 6
    End If
  End If
  Set rngDelete = Nothing
Next wsTab

Set rngCell = Nothing

End Sub

Ciao,
Holger