Sub Find_N_Select_Column_D()
Dim rFind As Range
Dim rValue As String
Dim rFound As Range
Dim rRange As Range
Dim strFirstAddress As String
Dim rRow As Long
Dim rFAddr 'As Range
Set rRange = Range("D10
Z130")
rValue = "Test"
With rRange
Set rFind = .Find(rValue, LookIn:=xlValues, lookat:=xlWhole)
If Not rFind Is Nothing Then
strFirstAddress = rFind.Address
Set rFound = rFind
Do
Set rFound = Union(rFound, rFind)
Set rFind = .FindNext(rFind)
Loop While Not rFind Is Nothing And rFind.Address <> strFirstAddress
End If
End With
If Not rFound Is Nothing Then
rFound.EntireRow.Select
End If
Application.ScreenUpdating = False
For rRow = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
If Intersect(Rows(rRow), Selection) Is Nothing Then
Rows(rRow).Delete
End If
Next rRow
Application.ScreenUpdating = True
End Sub