VBA Find .address sometimes returns range and other times a cell

Question

I'm having an issue with the VBA Range.Find method. What the code is doing is looking through all of the worksheets in a workbook, find any matches to data in an array, and change the color of the cell with the same value as that data.

The code works perfect on the first sheet. Then, on the next sheet, it gets hung in an infinite loop. After stepping through the code it seems that Find returns an address that is in Range format ("A2:A2") the first time it is running on this page but then reverts back to Cell format ("A2") after that. It doesn't do this on the first page, just the second one.

I could write some code to check the value returned and trim it down, but I want to fix the problem, not put a patch on it.

Here's the code that breaks:

For x = 1 To UBound(wksSheets)
    For y = 0 To (UBound(findData) - 1)
        With wkb.Worksheets(x)
            Set rng = .Range(DataRange).Find(findData(y), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                If Not rng Is Nothing Then
                    StrtAdd = rng.Address
                    Do
                        .Range(rng.Address).Interior.ColorIndex = 3
                        Set rng = .Range(DataRange).FindNext(rng)
                    Loop While Not rng Is Nothing And Not rng.Address = StrtAdd
                End If
        End With
    Next y
Next x

The first time through on the second page the rng.Address is "A2:A2" and gets stored in StrtAdd. Then, when the code hits the .FindNext(rng) rng.Address changes to "A2". Because of this, rng.Address is never equal to StrtAdd even though they are talking about the exact same cell. That's the infinite loop.

Any ideas on the best way to fix this?

wksSheets is an array that contains the worksheet names

findData contains the data that is to be found

Thanks in advance!!

Answer 1

Here is the code I ended up using. I still don't know why sometimes I am getting an address of A2:A2 and sometimes A1 but it does patch the issue.

I used InStr to find the : and then Left to knock the extra off.

I also incorporated the suggestions folks left about cleaning up the code.

For x = 1 To UBound(wksSheets)
        For y = 0 To UBound(findData) - 1
            With wkb.Worksheets(x)
                Set rng = .Range(DataRange).Find(findData(y), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                    If Not rng Is Nothing Then
                        z = InStr(rng.Address, ":")
                        If z > 1 Then
                            StrtAdd = Left(rng.Address, (z - 1))
                        Else:
                            StrtAdd = rng.Address
                        End If
                        Do
                            rng.Interior.ColorIndex = 3
                            Set rng = .Range(DataRange).FindNext(rng)
                        Loop While Not rng Is Nothing And Not rng.Address = StrtAdd
                    End If
            End With
        Next y
    Next x

While it's a patch, it's a working patch.

I didn't use @VBasic2008's suggestion of Application.Union because the code currently functions properly and I've got to get a version out. If I run into speed issues I will go back and make a new version.

Thanks everyone.