I want to find a value in colum "B" and delete all row above except
the first row.

I tried to adapt the code below without success.



Option Explicit

Sub delete_row_and_below()

Dim rFound As Range
Dim myRange As Range
Dim myLastRow As Long
Dim sName As String

myLastRow = ActiveSheet.Cells(65000, 2).End(xlUp).Row
Set myRange = ActiveSheet.Range("B1:B" & myLastRow)
sName = "LI-HANDTMG"

Set rFound = myRange.Find(What:=sName, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)

If rFound Is Nothing Then
MsgBox sName & " was not found in Range."
Else
Set myRange = ActiveSheet.Range("b" & rFound.Row _
& ":f" & myLastRow)
myRange.EntireRow.Delete
End If


End Sub



Thanks Little Penny