VBA array sort function? VBA array sort function? vba vba

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