VBA array sort function?

Question

I'm looking for a decent sort implementation for arrays in VBA. A Quicksort would be preferred. Or any other sort algorithm other than bubble or merge would suffice.

Please note that this is to work with MS Project 2003, so should avoid any of the Excel native functions and anything .net related.

Answer 1

Take a look here:
Edit: The referenced source (allexperts.com) has since closed, but here are the relevant author comments:

There are many algorithms available on the web for sorting. The most versatile and usually the quickest is the Quicksort algorithm. Below is a function for it.

Call it simply by passing an array of values (string or numeric; it doesn't matter) with the Lower Array Boundary (usually 0) and the Upper Array Boundary (i.e. UBound(myArray).)

Example: Call QuickSort(myArray, 0, UBound(myArray))

When it's done, myArray will be sorted and you can do what you want with it.
_{(Source: archive.org)}

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)   Dim pivot   As Variant   Dim tmpSwap As Variant   Dim tmpLow  As Long   Dim tmpHi   As Long    tmpLow = inLow   tmpHi = inHi    pivot = vArray((inLow + inHi) \ 2)    While (tmpLow <= tmpHi)      While (vArray(tmpLow) < pivot And tmpLow < inHi)         tmpLow = tmpLow + 1      Wend       While (pivot < vArray(tmpHi) And tmpHi > inLow)         tmpHi = tmpHi - 1      Wend       If (tmpLow <= tmpHi) Then         tmpSwap = vArray(tmpLow)         vArray(tmpLow) = vArray(tmpHi)         vArray(tmpHi) = tmpSwap         tmpLow = tmpLow + 1         tmpHi = tmpHi - 1      End If   Wend    If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi   If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi End Sub 

Note that this only works with single-dimensional (aka "normal"?) arrays. (There's a working multi-dimensional array QuickSort here.)

Answer 2

I converted the 'fast quick sort' algorithm to VBA, if anyone else wants it.

I have it optimized to run on an array of Int/Longs but it should be simple to convert it to one that works on arbitrary comparable elements.

Private Sub QuickSort(ByRef a() As Long, ByVal l As Long, ByVal r As Long)     Dim M As Long, i As Long, j As Long, v As Long     M = 4      If ((r - l) > M) Then         i = (r + l) / 2         If (a(l) > a(i)) Then swap a, l, i '// Tri-Median Methode!'         If (a(l) > a(r)) Then swap a, l, r         If (a(i) > a(r)) Then swap a, i, r          j = r - 1         swap a, i, j         i = l         v = a(j)         Do             Do: i = i + 1: Loop While (a(i) < v)             Do: j = j - 1: Loop While (a(j) > v)             If (j < i) Then Exit Do             swap a, i, j         Loop         swap a, i, r - 1         QuickSort a, l, j         QuickSort a, i + 1, r     End If End Sub  Private Sub swap(ByRef a() As Long, ByVal i As Long, ByVal j As Long)     Dim T As Long     T = a(i)     a(i) = a(j)     a(j) = T End Sub  Private Sub InsertionSort(ByRef a(), ByVal lo0 As Long, ByVal hi0 As Long)     Dim i As Long, j As Long, v As Long      For i = lo0 + 1 To hi0         v = a(i)         j = i         Do While j > lo0             If Not a(j - 1) > v Then Exit Do             a(j) = a(j - 1)             j = j - 1         Loop         a(j) = v     Next i End Sub  Public Sub sort(ByRef a() As Long)     QuickSort a, LBound(a), UBound(a)     InsertionSort a, LBound(a), UBound(a) End Sub