This will sort a 2-D variant array:


Function QuickSort(VA_array As Variant, _
Optional V_Low1 = -1, _
Optional V_high1 = -1)

Dim V_Low2 As Long
Dim V_high2 As Long
Dim V_val1 As Variant
Dim V_val2 As Variant

'If first time, get the size of the array to sort
If V_Low1 = -1 Then
V_Low1 = LBound(VA_array, 1)
End If

If V_high1 = -1 Then
V_high1 = UBound(VA_array, 1)
End If

'Set new extremes to old extremes
V_Low2 = V_Low1
V_high2 = V_high1

'Get value of array item in middle of new extremes
V_val1 = VA_array((V_Low1 + V_high1) / 2)

'Loop for all the items in the array between the extremes
While (V_Low2 <= V_high2)

'Find the first item that is greater than the mid-point item
While (VA_array(V_Low2) < V_val1 And V_Low2 < V_high1)
V_Low2 = V_Low2 + 1
Wend

'Find the last item that is less than the mid-point item
While (VA_array(V_high2) V_val1 And V_high2 V_Low1)
V_high2 = V_high2 - 1
Wend

'If the new 'greater' item comes before the new 'less' item, swap
them
If (V_Low2 <= V_high2) Then
V_val2 = VA_array(V_Low2)
VA_array(V_Low2) = VA_array(V_high2)
VA_array(V_high2) = V_val2

'Advance the pointers to the next item
V_Low2 = V_Low2 + 1
V_high2 = V_high2 - 1
End If
Wend

'Iterate to sort the lower half of the extremes
If (V_high2 V_Low1) Then Call QuickSort(VA_array, V_Low1, V_high2)

'Iterate to sort the upper half of the extremes
If (V_Low2 < V_high1) Then Call QuickSort(VA_array, V_Low2, V_high1)

QuickSort = VA_array

End Function


If you are dealing with an array of a particular datatype like for example a
string array then
you can speed this up by recoding for that datatype, eg for a string array:

Function QuickSortString(arrString() As String, _
Optional lLow1 = -1, _
Optional lhigh1 = -1)

Dim lLow2 As Long
Dim lhigh2 As Long
Dim strVal1 As String
Dim strVal2 As String

'If first time, get the size of the array to sort
If lLow1 = -1 Then
lLow1 = LBound(arrString, 1)
End If

If lhigh1 = -1 Then
lhigh1 = UBound(arrString, 1)
End If

'Set new extremes to old extremes
lLow2 = lLow1
lhigh2 = lhigh1

'Get value of array item in middle of new extremes
strVal1 = arrString((lLow1 + lhigh1) / 2)

'Loop for all the items in the array between the extremes
While (lLow2 <= lhigh2)

'Find the first item that is greater than the mid-point item
While (arrString(lLow2) < strVal1 And lLow2 < lhigh1)
lLow2 = lLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While (arrString(lhigh2) strVal1 And lhigh2 lLow1)
lhigh2 = lhigh2 - 1
Wend

'If the new 'greater' item comes before the new 'less' item, swap them
If (lLow2 <= lhigh2) Then
strVal2 = arrString(lLow2)
arrString(lLow2) = arrString(lhigh2)
arrString(lhigh2) = strVal2

'Advance the pointers to the next item
lLow2 = lLow2 + 1
lhigh2 = lhigh2 - 1
End If
Wend

'Iterate to sort the lower half of the extremes
If (lhigh2 lLow1) Then Call QuickSortString(arrString, lLow1, lhigh2)

'Iterate to sort the upper half of the extremes
If (lLow2 < lhigh1) Then Call QuickSortString(arrString, lLow2, lhigh1)

QuickSortString = arrString

End Function


RBS


"daniel17363" wrote in message
...
I want to sort an array using VBA independently of the spreadsheet. Thus I
have an array with 150 rows and 8 columns with the first column
characters. I
wish to select any column and order that column by value and maintain the
relationship with the other columns. Apparently VBA has no higher level
SORT
routine of this sort. Please correct me if I am incorrect and point to a
canned subroutine if I am correct.
Thank you,
DDH