And, for others who are interested in seeing how a merge sort works, I've rewritten Dave's
routine, splitting it into 4 separate Subs -- the main one, which calls the other 3. They are
(1) a routine to set up the stack array (I called it Ptrs()), (2) the insertion sort code, and
(3) the code to merge two adjacent segments into one. And I modified things to work with arrays
that have a lower bound other than 1.

As Dave mentioned in our email correspondence, in-line code undoubtedly runs faster than
separate subs, but the latter are easier to decipher.

I changed the array type from variant to double. The consequence of that is you need separate
code for sorting each data type. But I prefer that, because variants are inherently slow to work
with.

Option Explicit

Sub MergeSort(Ary() As Double)
'Based on code from Dave Ring, 08/15/2003,
Dim i As Long
Dim j As Long
Dim NumSegs As Long
Dim Ptrs() As Long
Dim Tmp() As Double

i = LBound(Ary)
j = UBound(Ary)
ReDim Tmp(i To j)

'partition the array into small segments with
'pointers to end of each segment in Ptrs()
NumSegs = MakePtrs(i, j, Ptrs())

'sort each segment with InsertionSort
For i = 1 To NumSegs
InsertionSort Ary(), Ptrs(i - 1) + 1, Ptrs(i)
Next i

'merge pairs of segments until only one is left
Do While NumSegs 1
For i = 2 To NumSegs Step 2
MergeSegments Ary(), Tmp(), _
Ptrs(i - 2) + 1, Ptrs(i - 1), Ptrs(i - 1) + 1, Ptrs(i)
Ptrs(i \ 2) = Ptrs(i)
Next i
NumSegs = NumSegs \ 2

For i = 2 To NumSegs Step 2
MergeSegments Tmp(), Ary(), _
Ptrs(i - 2) + 1, Ptrs(i - 1), Ptrs(i - 1) + 1, Ptrs(i)
Ptrs(i \ 2) = Ptrs(i)
Next i
NumSegs = NumSegs \ 2
Loop
End Sub

Private Function MakePtrs(Lo As Long, Hi As Long, Ptrs() As Long) As Long
'modified to handle arrays with lower bound < 1
Dim i As Long
Dim Size As Double
Dim NumSegs As Long
Dim N As Long

Size = Hi - Lo + 1
NumSegs = 1
Do While Size 20
Size = Size / 4
NumSegs = NumSegs * 4
Loop

'fill array with pointer to last element in each segment
ReDim Ptrs(0 To NumSegs)
Ptrs(0) = Lo - 1
Ptrs(NumSegs) = Hi
For i = 1 To NumSegs - 1
Ptrs(i) = i * Size + Lo - 1
Next i
MakePtrs = NumSegs
End Function

Sub InsertionSort(Ary() As Double, Lo As Long, Hi As Long)
Dim i As Long
Dim j As Long
Dim Tmp As Double

For i = Lo + 1 To Hi
Tmp = Ary(i)
For j = i - 1 To Lo Step -1
If Tmp < Ary(j) Then
Ary(j + 1) = Ary(j)
Else
Exit For
End If
Next j
Ary(j + 1) = Tmp
Next i
End Sub

Private Sub MergeSegments(Src() As Double, Dest() As Double, _
LeftFirst As Long, LeftLast As Long, RightFirst As Long, RightLast As Long)
Dim L As Long
Dim R As Long
Dim p As Long

L = LeftFirst
R = RightFirst
p = L - 1

Do
If Src(L) <= Src(R) Then
p = p + 1
Dest(p) = Src(L)

If L = LeftLast Then
For R = R To RightLast
p = p + 1
Dest(p) = Src(R)
Next R
Exit Do
Else
L = L + 1
End If

Else
p = p + 1
Dest(p) = Src(R)

If R = RightLast Then
For L = L To LeftLast
p = p + 1
Dest(p) = Src(L)
Next L
Exit Do
Else
R = R + 1
End If
End If
Loop
End Sub