XLA routines: EE_SortArray

Nick's picture
EE_SortArray does what it says on the tin: Sorts an array
Function EE_SortArray(ArrayToSort, Optional descending As Boolean)
'- takes array
'- sorts it
    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
    Dim numEls
 
'http://excelexperts.com/xla-routines-eeSortArray    for updates on this function

    ' account for optional arguments
    numEls = UBound(ArrayToSort)
    ' init pointers
    leftNdx = LBound(ArrayToSort)
    rightNdx = numEls
    ' init stack
    sp = 1
    leftStk(sp) = leftNdx
    rightStk(sp) = rightNdx
 
    Do
        If rightNdx > leftNdx Then
            value = ArrayToSort(rightNdx)
            i = leftNdx - 1
            j = rightNdx
            ' find the pivot item
            If descending Then
                Do
                    Do: i = i + 1: Loop Until ArrayToSort(i) <= value
                    Do: j = j - 1: Loop Until j = leftNdx Or ArrayToSort(j) >= value
                    temp = ArrayToSort(i)
                    ArrayToSort(i) = ArrayToSort(j)
                    ArrayToSort(j) = temp
                Loop Until j <= i
            Else
                Do
                    Do: i = i + 1: Loop Until ArrayToSort(i) >= value
                    Do: j = j - 1: Loop Until j = leftNdx Or ArrayToSort(j) <= value
                    temp = ArrayToSort(i)
                    ArrayToSort(i) = ArrayToSort(j)
                    ArrayToSort(j) = temp
                Loop Until j <= i
            End If
            ' swap found items
            temp = ArrayToSort(j)
            ArrayToSort(j) = ArrayToSort(i)
            ArrayToSort(i) = ArrayToSort(rightNdx)
            ArrayToSort(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
 
    EE_SortArray = ArrayToSort
End Function