find and findnext

[sunilpatel]

i need to select every cell in coulmn 1 that has a certain string e.g "cat",
then move down until each one is found.
Then following is my attempt!!!!

problem is first cell is never selected and secondly is i need to repeat
code, once with .find and then with .findnext

Can someone please simplify this lot?

Sub FindCat()

Dim CK As Object
Range("A1").Select
ActiveCell.FormulaR1C1 = "CAT"
Range("A2").Select
ActiveCell.FormulaR1C1 = "DOG"
Range("A3").Select
ActiveCell.FormulaR1C1 = "ABIGCAT"
Range("A4").Select
ActiveCell.FormulaR1C1 = "PIG"
Range("A5").Select
ActiveCell.FormulaR1C1 = "NOCAT"
Range("A6").Select
ActiveCell.FormulaR1C1 = "MOUSE"
Range("A7").Select
ActiveCell.FormulaR1C1 = "CAT"
Range("A8").Select

Set CK = Columns(1).Find("CAT")
If Not CK Is Nothing Then
CK.Select
' THEN ASSUME LOTS OF CODE
End If

first% = CK.Row
While CK <> ""
Set CK = Columns(1).FindNext(CK) 'try again... as not exact match
If CK Is Nothing Then
End
ElseIf CK <> "" Then
CK.Select
' THEN ASSUME LOTS OF CODE
End If
Wend
End Sub

 

[Per Jessen]

Hi

Try this:

Sub FindCat()
......
Set CK = Columns(1).Find(what:="CAT", after:=Range("A1"),
Lookat:=xlPart)
If Not CK Is Nothing Then
CK.Select
' THEN ASSUME LOTS OF CODE
End If

first% = CK.Row
Set CK = Columns(1).FindNext(CK) 'try again... as not exact match
Do

If CK <> "" Then
CK.Select
' THEN ASSUME LOTS OF CODE
End If
Set CK = Columns(1).FindNext(CK) 'try again... as not exact match

Loop Until CK.Row = first%
End Sub

Regards,
Per