VBA Loop .Find update 'After' value

Question

Is it possible to update the 'After' value while looping through a .Find ?

I have a sheet with multiple sets of data and I am basically trying to find a way to use .Find for multiple criteria.

Example Data:

|Pet     |Colour     |Treats     |
|Cat     |Black      |1          |
|Cat     |Black      |2          |
|Cat     |Black      |3          |
|Cat     |White      |1          |
|Cat     |White      |2          |
|Cat     |White      |3          |
|Dog     |Black      |1          |
|Dog     |Black      |2          |
|Dog     |Black      |3          |
|Dog     |White      |1          |
|Dog     |White      |2          |
|Dog     |White      |3          |

Code:

Dim foundCell As Range
Set foundCell = .Range("A2")
MsgBox "Pre foundCell = " & foundCell.Value

For Each x In Array(Pet, Colour)
Set search = .Find(What:=x, After:=foundCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        foundCell.Cells = Range(search.Address) '<---- doesnt work
        MsgBox "Post foundCell = " & foundCell.Value
Next x

So if I search for a Black Dog, the 1st loop finds Dog (at A8) but then resets to the 1st occurance of the Colour 'Black' (B2) so in the end I get the wrong row. I was hoping to update the 'foundCell' value and use that as the point for the 2nd loop to start but it always seems to reset back to the original Cell value.

Answer 1

This is a basic version of how you could do it.
This works for the example given - it would return incorrect results if, for example, you had all white dogs and then a couple of black parrots afterwards - it only checks if the colour occurs after the row the animal is found on.

You could change the size of the search range so it finds Dog and only searches for the colour within the range of dogs. This would need to be done before the second FIND statement but after the code has confirmed an animal has been found. Resize should be able to deal with that, along with a count of the found animal and the returned row number that the animal is found on. Edit: Have added this to the code.

The second FIND only uses a couple of parameters (what to find and where to start looking) as the other parameters are carried over from the previous FIND .

Edit2: This will return the first row that animal appears on and then first row that colour, within the range of animal, occurs on - so if it finds a colour it will be the colour for that animal. This needs the Pet column to be sorted as it will return the wrong animal count if you've got another bunch of cats and dogs further down the list.

Sub Test()

    Dim rFoundAnimal As Range
    Dim rFoundColour As Range
    Dim rSearchRange As Range
    Dim Animal As String
    Dim Colour As String

    Dim AnimalCount As Long

    Animal = "Dog"
    Colour = "Black"

    With ThisWorkbook.Worksheets("Sheet4")
        Set rSearchRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) 'Search Range A1:A13.
    End With
    With rSearchRange
        Set rFoundAnimal = rSearchRange.Find(What:=Animal, _
                                             After:=.Cells(1, 1), _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False)
    End With
    'Animal has been found.
    If Not rFoundAnimal Is Nothing Then
        AnimalCount = WorksheetFunction.CountIf(rSearchRange, Animal)
        Set rSearchRange = rFoundAnimal.Offset(, 1).Resize(AnimalCount)
        With rSearchRange
            'Start search at bottom of list - it wraps around so first searched cell is at top of list.
            Set rFoundColour = .Find(What:=Colour, After:=.Cells(.Rows.Count, 1))
        End With
        'Colour has been found.
        If Not rFoundColour Is Nothing Then
            MsgBox "Animal:  " & rFoundAnimal.Address & vbCr & _
                   "Colour:  " & rFoundColour.Address
        Else
            MsgBox "Animal: " & rFoundAnimal.Address & vbCr & _
                   "Colour not found."
        End If
    Else
        MsgBox "Animal not found."
    End If

End Sub