Sort Multidimensional Array

[mikerickson]

This UDF should do the trick
QSortedArray() takes either a range or an array as its first argument, the second and third arguments (optional) are the columns to sort on. The Decenting determines if the sort is ascending (default) descending.

Option Explicit
Public imageArray As Variant
Public keyCol As Long, keyCol2

Function QSortedArray(ByVal inputRange As Variant, Optional keyColumn As Long, Optional keyColumn2 As Long, Optional Descending As Boolean) As Variant
    Dim RowArray As Variant
    Dim outRRay As Variant
    Dim i As Long, j As Long, size As Long
If keyColumn = 0 Then keyColumn = 1
Rem Input array vs range handeling
    On Error GoTo HaltFunction
    Select Case TypeName(inputRange)
    Case Is = "Range"
        If inputRange.Columns.Count < keyColumn Then
            QSortedArray = CVErr(xlErrRef): Exit Function
        Else
            Set inputRange = Application.Intersect(inputRange, inputRange.Parent.UsedRange)
            If inputRange Is Nothing Then
                QSortedArray = Array(vbNullString): Exit Function
            Else
                imageArray = inputRange.Value
            End If
        End If
Case Is = "Variant()", "String()", "Double()", "Long()"
        If UBound(inputRange, 2) < keyColumn Then
            QSortedArray = Array(CVErr(xlErrRef)): Exit Function
        Else
            imageArray = inputRange
        End If
Case Else
        QSortedArray = CVErr(xlErrNA): Exit Function
    End Select
    On Error GoTo 0
Rem pass arguments To Public variables
If keyColumn2 = 0 Then keyColumn2 = keyColumn
    If UBound(imageArray, 2) < keyColumn Then QSortedArray = CVErr(xlErrRef): Exit Function
    If UBound(imageArray, 2) < keyColumn2 Then QSortedArray = CVErr(xlErrRef): Exit Function
    keyCol = keyColumn
    keyCol2 = keyColumn2
Rem create array of row numbers {1,2,3,...,Rows.Count}
    size = UBound(imageArray, 1)
    ReDim RowArray(1 To size)
    For i = 1 To size
        RowArray(i) = i
    Next i
Rem sort row numbers
    Call sortQuickly(RowArray, Descending)
Rem read imageArray With row order per the sorted RowArray
    ReDim outRRay(1 To size, 1 To UBound(imageArray, 2))
    For i = 1 To size
        For j = 1 To UBound(outRRay, 2)
            outRRay(i, j) = imageArray(RowArray(i), j)
        Next j
    Next i
QSortedArray = outRRay
Erase imageArray
HaltFunction:
    On Error GoTo 0
End Function
 
Sub sortQuickly(ByRef inRRay As Variant, Optional ByVal Descending As Boolean, Optional ByVal low As Long, Optional ByVal high As Long)
    Dim pivot As Variant
    Dim i As Long, pointer As Long
    If low = 0 Then low = LBound(inRRay)
    If high = 0 Then high = UBound(inRRay)
pointer = low
Call Swap(inRRay, (low + high) / 2, high)
    pivot = inRRay(high)
For i = low To high - 1
        If LT(inRRay(i), pivot) Xor Descending Then
            Call Swap(inRRay, i, pointer)
            pointer = pointer + 1
        End If
    Next i
    Call Swap(inRRay, pointer, high)
    If low < pointer - 1 Then
        Call sortQuickly(inRRay, Descending, low, pointer - 1)
    End If
    If pointer + 1 <= high Then
        Call sortQuickly(inRRay, Descending, pointer + 1, high)
    End If
End Sub
 
Function LT(aRow As Variant, bRow As Variant, Optional Descending As Boolean) As Boolean
    On Error GoTo HaltFtn
    LT = Descending
    If imageArray(aRow, keyCol) = imageArray(bRow, keyCol) Then
        LT = imageArray(aRow, keyCol2) < imageArray(bRow, keyCol2)
    Else
        LT = (imageArray(aRow, keyCol) < imageArray(bRow, keyCol))
    End If
HaltFtn:
    On Error GoTo 0
End Function
 
Sub Swap(ByRef inRRay, a As Long, b As Long)
    Dim temp As Variant
    temp = inRRay(a)
    inRRay(a) = inRRay(b)
    inRRay(b) = temp
End Sub