View Full Version : Sort Array VBA


ajetrumpet
06-20-2010, 05:28 PM
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)
Debug.Print ArrayToSort(i)
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("TABLE", dbOpenDynaset)

rs.MoveLast
rs.MoveFirst

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

Dim myarray() As Variant

'RESIZE ARRAY TO TABLE SPECS
Do Until rs.EOF
For i = 0 To cols
ReDim myarray(i + 1, rs.AbsolutePosition + 1)
Next i
rs.MoveNext
Loop

rs.MoveFirst

'POPULATE ARRAY WITH TABLE DATA
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, COLUMN NUMBER TO SORT)

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)

'SORT THE COLUMN VALUES HERE
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

'USE SORTED COLUMN VALUES TO STORE RELATED ROW NUMBERS IN A NEW ARRAY
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("TABLE", dbOpenDynaset)

rs.MoveLast
rs.MoveFirst

'REPOPULATE TABLE WITH SORTED DATA
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