Sort Array VBA (1 Viewer)

[ajetrumpet]

These code snippets sort values in the following order: NULLS (must be converted to 0-length strings), special characters (in numerical order from CHR() chart), numbers, upper case, lower case

Here's the code to sort a one-dimensional array:

Function SortArray(ArrayToSort() As Variant) As Variant
     
    Dim First           As Integer
    Dim Last            As Integer
    Dim i               As Integer
    Dim j               As Integer
    Dim Temp            As String
     
    First = LBound(ArrayToSort)
    Last = UBound(ArrayToSort)
    For i = First To Last - 1
        For j = i + 1 To Last
            If ArrayToSort(i) > ArrayToSort(j) Then
                Temp = ArrayToSort(j)
                ArrayToSort(j) = ArrayToSort(i)
                ArrayToSort(i) = Temp
            End If
        Next j
    Next i
    
        For i = 1 To UBound(ArrayToSort)
            [COLOR="Red"]Debug.Print ArrayToSort(i)[/COLOR]
        Next i

End Function

If you want to sort an array with 2 dimensions, it's just like sorting rows of data on an excel sheet based on ONE column only (e.g. - sorting a table based on a column). For example, number of columns would be the 1st dimension and the number of rows would be the 2nd. Here's an example of sorting a table this way (this can adapted to work in Excel too):

Function GetTableArray()

Dim i As Long
Dim rows As Long
Dim cols As Long

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("[COLOR="red"]TABLE[/COLOR]", dbOpenDynaset)
    
    rs.MoveLast
    rs.MoveFirst

rows = rs.RecordCount
cols = rs.Fields.Count - 1

    Dim myarray() As Variant
    
        [COLOR="Green"]'RESIZE ARRAY TO TABLE SPECS[/COLOR]
        Do Until rs.EOF
            For i = 0 To cols
                ReDim myarray(i + 1, rs.AbsolutePosition + 1)
            Next i
                rs.MoveNext
        Loop
        
                rs.MoveFirst

        [COLOR="green"]'POPULATE ARRAY WITH TABLE DATA[/COLOR]
        Do Until rs.EOF
            For i = 0 To cols
                myarray(i, rs.AbsolutePosition) = IIf(IsNull(rs.Fields(i)), "", rs.Fields(i))
            Next i
                rs.MoveNext
        Loop

rs.Close
Set rs = Nothing

        Call SortArray(myarray, [COLOR="Red"]COLUMN NUMBER TO SORT[/COLOR])
    
End Function



Function SortArray(ArrayToSort() As Variant, SortCol As Integer) As Variant

On Error Resume Next

    Dim First           As Integer
    Dim Last            As Integer
    Dim i               As Integer
    Dim j               As Integer
    Dim k               As Integer
    Dim Temp            As String
    Dim prev            As String
    Dim s               As String
    Dim origarray()     As Variant
    Dim rowarray()      As Variant

origarray = ArrayToSort()
SortCol = SortCol - 1
k = 0

    First = LBound(ArrayToSort, 2)
    Last = UBound(ArrayToSort, 2)
    
    [COLOR="Green"]'SORT THE COLUMN VALUES HERE[/COLOR]
    For i = First To Last - 1
        For j = i + 1 To Last
            If ArrayToSort(SortCol, i) > ArrayToSort(SortCol, j) Then
                Temp = ArrayToSort(SortCol, j)
                ArrayToSort(SortCol, j) = ArrayToSort(SortCol, i)
                ArrayToSort(SortCol, i) = Temp
            End If
        Next j
    Next i
    
    [COLOR="green"]'USE SORTED COLUMN VALUES TO STORE RELATED ROW NUMBERS IN A NEW ARRAY[/COLOR]
    For i = 1 To UBound(ArrayToSort, 2)
        If IIf(ArrayToSort(SortCol, i) = "", "NULL", ArrayToSort(SortCol, i)) <> prev Then
            For j = 0 To UBound(origarray, 2) - 1
                If IIf(origarray(SortCol, j) = "", "NULL", origarray(SortCol, j)) = _
                   IIf(ArrayToSort(SortCol, i) = "", "NULL", ArrayToSort(SortCol, i)) Then
                    ReDim Preserve rowarray(k)
                    rowarray(k) = j
                    k = k + 1
                End If
            Next j
        End If
                        prev = IIf(ArrayToSort(SortCol, i) = "", "NULL", ArrayToSort(SortCol, i))
    Next i

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("[COLOR="red"]TABLE[/COLOR]", dbOpenDynaset)
    
    rs.MoveLast
    rs.MoveFirst

    [COLOR="green"]'REPOPULATE TABLE WITH SORTED DATA[/COLOR]
    Do Until rs.EOF

        For i = 0 To UBound(origarray, 2)
            For j = 0 To UBound(origarray, 1)
                rs.Edit
                rs.Fields(j) = origarray(j, rowarray(i))
                rs.Update
            Next j
                rs.MoveNext
        Next i
    
    Loop

rs.Close
Set rs = Nothing

End Function