sort an array on selected column

[daniel17363]

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

 

[Per Jessen]

Hi

Select your data range, then goto Data > Sort > Sort By (select the column
you want to sort by) > OK

Regards,
Per

 

[daniel17363]

Thanks but as stated I want this sort to be independent of the spreadsheet.
The array is defined in VBA and not associated with a range in the
spreadsheet.

 

[Bob Phillips]

If you want to sort the array, you will need to cut your own. There are many
examples of bubble or quicksorts out there that will do the job.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Rick Rothstein \(MVP - VB\)]

I've not tried this myself, but it looks as if it might work (take the code
out of the .inc file and remove the <% and %> from the beginning and end of
the file)...

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?lngWId=4&txtCodeId=6482

The code was written for VBScript; but, after a quick look, I think it will
work as is in VB. One note though, all variables are (default) declared as
Variants meaning the code will be slower than is necessary. If you want to
take the time and specify appropriate data types for the variables, that
will help make the code faster.

Rick

 

[RB Smissaert]

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