Finding occurrences in order — VBA

Question

I am using the code that I obtained from this website, Find All Instances With VBA. Everything works fine, but for some reason it starts with the second occurrence loops to the end of file, then obtains the first.

For example:

-- Sample Data:

Origin  X   Y
S   45  65
W   78  7
S   45  5
D   6   3
B   75  68
S   19  87
T   23  98
S   33  94
Q   21  105
S   17  117
T   12  128

When I try to find all occurrence in column Origin of letter "S", then I retrieve the address through Debug.Print (rng.Address) it would provide $A$4,$A$7,$A$9,$A$11,$A$2.

Why is $A$2 being shown last? This has happened throughout all my different excel files.

Here is the code:

Sub FindAll()

'PURPOSE: Find all cells containing a specified values
'SOURCE: www.TheSpreadsheetGuru.com

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
  fnd = "S"

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)

    'Add found cell to rng range variable
      Set rng = Union(rng, FoundCell)

    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do

  Loop

'Select Cells Containing Find Value
  rng.Select

  Debug.Print (rng.Address)

Exit Sub

'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"

End Sub

Answer 1

your loop actually finds A2 as the first cell but then it finds it again because you're looping one more time after Find() wraps back to the first found cell.

thus Set rng = Union(rng, FoundCell) adds A2 once again to rng as the last found cell, and that's why you see it listed at the bottom

You must move the checking as the ending condition of your loop and not to have Set rng = Union(rng, FoundCell) run after wrapping back

like follows:

Option Explicit

Sub FindAll()
    'PURPOSE: Find all cells containing a specified values
    'SOURCE: www.TheSpreadsheetGuru.com

    Dim fnd As String, FirstFound As String
    Dim FoundCell As Range, rng As Range

    'What value do you want to find (must be in string form)?
    fnd = "S"

    With ActiveSheet.UsedRange '<--| reference the range to search into
        Set FoundCell = .Find(what:=fnd, after:=.Cells(.Cells.Count)) '<--| find the first cell

        If Not FoundCell Is Nothing Then 'Test to see if anything was found
            FirstFound = FoundCell.Address ' <--| store the first found cell address
            Set rng = FoundCell '<--| initialize the range collecting found cells. this to prevent first 'Union()' statement from failing due to 'rng' being 'Nothing'
            Do
                Set rng = Union(rng, FoundCell)  'Add found cell to rng range variable

                'Find next cell with fnd value
                Set FoundCell = .FindNext(after:=FoundCell)
            Loop While FoundCell.Address <> FirstFound 'Loop until cycled through all finds

            rng.Select 'Select Cells Containing Find Value
            Debug.Print (rng.Address)
        Else
            MsgBox "No values were found in this worksheet"
        End If
    End With
End Sub

Answer 2

Change your loop in the middle to:

'What value do you want to find (must be in string form)?
fnd = "S"

Set myRange = ActiveSheet.UsedRange

With myRange
    Set FoundCell = .Find(fnd, LookIn:=xlValues)
    If Not FoundCell Is Nothing Then
        firstAddress = FoundCell.Address

        Do
            'Add found cell to rng range variable
            If rng Is Nothing Then
                Set rng = FoundCell '<-- add first range found
            Else
                Set rng = Union(rng, FoundCell) '<-- add ranges by using Union
            End If

            Set FoundCell = .FindNext(FoundCell)
            If FoundCell Is Nothing Then
                GoTo DoneFinding
            End If
            Loop While Not FoundCell Is Nothing And FoundCell.Address <> firstAddress
    End If
DoneFinding:
End With

Debug.Print (rng.Address)