Try this code........
Sub FindData()
Dim lr As Long
' FindData Macro
Application.ScreenUpdating = False
Range("A2").Select
Range("A2:A10000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("G2:G3"), CopyToRange:=Range("H2"), Unique:=False
lr = Cells(Rows.Count, "H").End(xlUp).Row
For i = lr To 3 Step -1
If Application.WorksheetFunction.IsText(Range("H" & i)) = True And Application.WorksheetFunction.IsNumber(Range("H" & i + 1)) = False Then
Range("H" & i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Please find the attached sheet.
Is this what you want?
Bookmarks