Sub test()
Dim x As Range, a As String
With Range("A1:A3")
Set x = .Find(Range("B1").Value, , xlValues, xlPart, , , False)
If Not x Is Nothing Then
a = x.Address
Do
x.Interior.ColorIndex = 3
Set x = .FindNext(x)
Loop While Not x Is Nothing And x.Address <> a
End If
End With
End Sub