This is a function to sort a 2D array I got from the internet some years
ago.
I can't remember who wrote this one, but it wasn't me.
'***************************************************************************
'*
'* FUNCTION NAME: SORT ARRAY - 2D
'*
'* DESCRIPTION: Sorts the passed array into required order, using the
'* given key. The array must be a 2D array of any size.
'*
'* PARAMETERS: avArray The array of values to sort
'* sOrder A-Ascending, D-Descending
'* iKey The number of the column to sort on
'* iLow1 The first item to sort between
'* iHigh1 The last item to sort between
'*
'***************************************************************************
Sub procSort2D(avArray, _
ByVal sOrder As String, _
ByVal iKey As Integer, _
ByVal iLow1 As Integer, _
ByVal iHigh1 As Integer)
On Error Resume Next
'Dimension variables
Dim iLow2 As Integer
Dim iHigh2 As Integer
Dim i As Integer
Dim vItem1 As Variant
Dim vItem2 As Variant
'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1
'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)
'Loop for all the items in the array between the extremes
While iLow2 < iHigh2
If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend
'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) > vItem1 And iHigh2 > iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) > vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend
'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 > iLow1
iHigh2 = iHigh2 - 1
Wend
End If
'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If
'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend
'Recurse to sort the lower half of the extremes
If iHigh2 > iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2
'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1
End Sub
Once you have your array sorted you can do something like this:
'count the number of unique entries
For i = 1 To LR
If tempArray(i, 0) <> tempArray(i - 1, 0) Then
uCo2 = uCo2 + 1
End If
Next
ReDim tempArray2(0 To uCo2, 0 To LC)
'do the first row
For c = 0 To LC
tempArray2(0, c) = tempArray(0, c)
Next
'do the further rows
For i = 1 To LR
If tempArray(i, 0) <> tempArray(i - 1, 0) Then
n = n + 1
For c = 0 To LC
tempArray2(n, c) = tempArray(i, c)
Next
End If
Next
RBS