VBA array sort function?
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, inHiEnd Sub
Note that this only works with single-dimensional (aka "normal"?) arrays. (There's a working multi-dimensional array QuickSort here.)
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 IfEnd SubPrivate 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) = TEnd SubPrivate 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 iEnd SubPublic Sub sort(ByRef a() As Long) QuickSort a, LBound(a), UBound(a) InsertionSort a, LBound(a), UBound(a)End Sub
Dim arr As ObjectDim InputArray'Creating a array listSet arr = CreateObject("System.Collections.ArrayList")'StringInputArray = Array("d", "c", "b", "a", "f", "e", "g")'number'InputArray = Array(6, 5, 3, 4, 2, 1)' adding the elements in the array to array_listFor Each element In InputArray arr.Add elementNext'sorting happensarr.Sort'Converting ArrayList to an array'so now a sorted array of elements is stored in the array sorted_array.sorted_array = arr.toarray