FINDPREVIOUS on UNION not cycling correctly

[Walter Briscoe]

I run VBA in Microsoft Visual Basic 6.5.1053 from Microsoft Office Excel
2003 (11.8332.8333) SP3 from Windows Vista Business Service Pack 2.

I have never before used UNION to construct a Range.
I have never before used FindPrevious.
I am lucky I hit a 'bug' with an early set of data.

I think I have found a bug I have not seen reported.

UNION joins two ranges with a gap.
FindPrevious finds several matches in the first of those ranges.
No data matches in the second of those ranges.
When the FindPrevious After parameter is set to the top match of the
first range, the function should find the last match in that range.
It actually returns the first match again.

I enclose code which can be used to show the behavior.
It simplifies real data. It can be run in an empty worksheet.
I also have code showing FindNext works as expected in a similar case.

If BUG is changed from True to False, a workround is shown.

Do people agree this is a bug?
Does the behavior exist in more modern versions of Excel?

Option Explicit

Const BUG As Boolean = True ' Set False to demonstrate workaround
Const MatchCol As Long = 4
Const CalcColm As Long = 6

Const LastSortedRow As Long = 35
Const OIL As Long = 15
Const DIL As Long = 29

Public Sub aatrial()
' Minimal example of findprevious problem
' When FindPrevious is applied at the first match of the first of
' two ranges in a union, it does not loop over the second range to
' find the last match in the first range.
' It finds the first match again.
'
Dim C As Range
Dim FirstAddress As String
Dim LastAddress As String
Dim Products As Range

Call setData

If BUG Then
Set Products = Application.Union( _
Range(Cells(2, CalcColm), Cells(OIL + 1, CalcColm)), _
Range(Cells(DIL + 1, CalcColm), Cells(LastSortedRow, CalcColm)))
Else
Set Products = _
Range(Cells(2, CalcColm), _
Cells(LastSortedRow, CalcColm))
End If
Debug.Print Products.Address
Set C = Products.Find(What:=1, After:=Cells(OIL + 1, CalcColm), _
LookIn:=xlValues, SearchDirection:=xlPrevious)
Debug.Assert Not C Is Nothing
FirstAddress = C.Address
Do
Debug.Print C.Address
LastAddress = C.Address
Set C = Products.FindPrevious(C)
Debug.Assert C.Address <> LastAddress ' Fails here with BUG
Loop While C.Address <> FirstAddress
Debug.Print C.Address & " is where loop ends"

' Find/FindNext works correctly
Set C = Products.Find(What:=1, After:=Cells(2, CalcColm), _
LookIn:=xlValues, SearchDirection:=xlNext)
Debug.Assert Not C Is Nothing
FirstAddress = C.Address
Do
Debug.Print C.Address
Set C = Products.FindNext(C)
Loop While C.Address <> FirstAddress
Debug.Print C.Address & " is where loop ends"
End Sub

Private Sub setData()
Dim I As Long

Union(Columns(MatchCol), Columns(CalcColm)).ClearContents
For I = 2 To LastSortedRow: Cells(I, MatchCol) = I - 1: Next I
For I = 2 To OIL - 2: Cells(I, CalcColm) = 1: Next I
For I = OIL - 1 To OIL + 1: Cells(I, CalcColm) = 2: Next I
For I = DIL + 1 To LastSortedRow: Cells(I, CalcColm) = 2: Next I

' With this set, behavior is good
' For I = DIL + 2 To DIL + 2: Cells(I, CalcColm) = 1: Next I

If Not BUG Then
For I = OIL + 2 To DIL: Cells(I, CalcColm) = 0: Next I ' Pack gap
End If
End Sub