Find loop doesn't loop

[JSnow]

I am creating a simple find loop to find all the "smith" entries in column A.
I copy & pasted this code from Ozgrid and modified slightly.

Sub findSmith()

Dim lCount As Long
Dim rFoundCell As Range

Set rFoundCell = Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), "smith")
Set rFoundCell = Columns(1).Find(What:="smith", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

rFoundCell.Select
MsgBox ("You are here.")

Next lCount
End Sub

However, it only finds the first instance of "smith" in column A and stops.
Can anyone shed some light on this?

Thank you, JSnow

 

[Luke M]

The macro is working correctly for me. Are you perhaps wanting to search for
"Smith" surrounded by other text or spaces? If so, you could make the
following change:

For lCount = 1 To WorksheetFunction.CountIf(Columns(1), "*smith*")

 

[Don Guillett]

You may actually prefer FINDNEXT instead. Look in the vba help index.