if word found delete 3 rows from another column

[diimoo1]

Hi - Would like to get your help below if possible.

I have data that look like

Column1	Column2
speed	XXX
Other Value
Other Value
Other Value
Other Value
Speed
Other Value
Other Value
Other Value	XXX
Other Value
Other Value
Other Value
speed
Other Value
Other Value
Other Value
Other value	XXX

desired result:

Column1	Column2
speed	XXX
Other Value
Other Value
Other Value
Other Value
Speed	XXX
Other Value
Other Value
Other Value
Other Value
Other Value
Other Value
speed	XXX
Other Value
Other Value
Other Value
Other value

I tried the below code - but no luck

Sub DeleteRow()
  Dim R As Range, cellsToDel As String
  'looking for cells that contain the word 'speed'
  Set R = ActiveSheet.Range("A:A").Find("speed", LookIn:=xlValues)
  'if found
  Do While Not R Is Nothing
    'get cells address to be deleted
    cellsToDel = "B" & R.Row - 3 & ":A" & R.Row + 0
    'delete the cells
    ActiveSheet.Range(cellsToDel).Delete xlShiftUp
    'looking for cells that contain the word 'bottom' again
    Set R = ActiveSheet.Range("A:A").Find("speed", LookIn:=xlValues)
  Loop
End Sub

thanks in advance

 

[My Aswer Is This]

Please tell me in words what you want.
So if some value is in Column 1 do this.
Do not ask me to read your script

 

[diimoo1]

Yes definitely - If column A contains or found " Speeed" then delete 3 cells up in Column B's next non-empty cell ( i.e XXX)
Basically, delete the 3 rows before "XXX" - and do next "XX" until the last "speed" found in column A

Thanks