QuickSort

Sub QuickSort(arr As Variant, Optional numEls As Variant, _
    Optional descending As Boolean)

Dim value As Variant, temp As Variant
    Dim sp As Integer
    Dim leftStk(32) As Long, rightStk(32) As Long
    Dim leftNdx As Long, rightNdx As Long
    Dim i As Long, j As Long

' account for optional arguments
    If IsMissing(numEls) Then numEls = UBound(arr)
    ' init pointers
    leftNdx = LBound(arr)
    rightNdx = numEls
    ' init stack
    sp = 1
    leftStk(sp) = leftNdx
    rightStk(sp) = rightNdx

Do
        If rightNdx > leftNdx Then
            value = arr(rightNdx)
            i = leftNdx - 1
            j = rightNdx
            ' find the pivot item
            If descending Then
                Do
                    Do: i = i + 1: Loop Until arr(i) <= value
                    Do: j = j - 1: Loop Until j = leftNdx Or arr(j) >= value
                    temp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = temp
                Loop Until j <= i
            Else
                Do
                    Do: i = i + 1: Loop Until arr(i) >= value
                    Do: j = j - 1: Loop Until j = leftNdx Or arr(j) <= value
                    temp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = temp
                Loop Until j <= i
            End If
            ' swap found items
            temp = arr(j)
            arr(j) = arr(i)
            arr(i) = arr(rightNdx)
            arr(rightNdx) = temp
            ' push on the stack the pair of pointers that differ most
            sp = sp + 1
            If (i - leftNdx) > (rightNdx - i) Then
                leftStk(sp) = leftNdx
                rightStk(sp) = i - 1
                leftNdx = i + 1
            Else
                leftStk(sp) = i + 1
                rightStk(sp) = rightNdx
                rightNdx = i - 1
            End If
        Else
            ' pop a new pair of pointers off the stacks
            leftNdx = leftStk(sp)
            rightNdx = rightStk(sp)
            sp = sp - 1
            If sp = 0 Then Exit Do
        End If
    Loop
End Sub

QuickSort an array of any type
QuickSort is especially convenient with large arrays 
(>1,000 items) that contains items in random order. 
Its performance quickly degrades if the array is already 
almost sorted. (There are variations of the QuickSort 
algorithm that work good with nearly-sorted arrays, though, 
but this routine doesn't use them.) NUMELS is the index of 
the last item to be sorted, and is useful if the array is 
only partially filled. Works with any kind of array, except 
UDTs and fixed-length strings, and including objects if your 
are sorting on their default property. String are sorted in 
case-sensitive mode. You can write faster procedures if you 
modify the first two lines to account for a specific data 
type, eg.

Sub QuickSortS(arr() As Single, Optional numEls As Variant,
Optional descending As Boolean)
Dim value As Single, temp As Single

Sub QuickSort(arr As Variant, Optional numEls As Variant, _
Optional descending As Boolean)

Dim value As Variant, temp As Variant
Dim sp As Integer
Dim leftStk(32) As Long, rightStk(32) As Long
Dim leftNdx As Long, rightNdx As Long
Dim i As Long, j As Long

' account for optional arguments

If IsMissing(numEls) Then numEls = UBound(arr)
' init pointers

leftNdx = LBound(arr)
rightNdx = numEls
' init stack

sp = 1
leftStk(sp) = leftNdx
rightStk(sp) = rightNdx

Do
If rightNdx > leftNdx Then
value = arr(rightNdx)
i = leftNdx - 1
j = rightNdx
' find the pivot item

If descending Then
Do
Do: i = i + 1: Loop Until arr(i) <= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) >= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
Else
Do
Do: i = i + 1: Loop Until arr(i) >= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) <= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
End If
' swap found items

temp = arr(j)
arr(j) = arr(i)
arr(i) = arr(rightNdx)
arr(rightNdx) = temp
' push on the stack the pair of pointers that differ most

sp = sp + 1
If (i - leftNdx) > (rightNdx - i) Then
leftStk(sp) = leftNdx
rightStk(sp) = i - 1
leftNdx = i + 1
Else
leftStk(sp) = i + 1
rightStk(sp) = rightNdx
rightNdx = i - 1
End If
Else
' pop a new pair of pointers off the stacks

leftNdx = leftStk(sp)
rightNdx = rightStk(sp)
sp = sp - 1
If sp = 0 Then Exit Do
End If
Loop
End Sub

QuickSort an array of any type
QuickSort is especially convenient with large arrays
(>1,000 items) that contains items in random order.
Its performance quickly degrades if the array is already
almost sorted. (There are variations of the QuickSort
algorithm that work good with nearly-sorted arrays, though,
but this routine doesn't use them.) NUMELS is the index of
the last item to be sorted, and is useful if the array is
only partially filled. Works with any kind of array, except
UDTs and fixed-length strings, and including objects if your
are sorting on their default property. String are sorted in
case-sensitive mode. You can write faster procedures if you
modify the first two lines to account for a specific data
type, eg.

Sub QuickSortS(arr() As Single, Optional numEls As Variant,
Optional descending As Boolean)
Dim value As Single, temp As Single