View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Tim Williams Tim Williams is offline
external usenet poster
 
Posts: 1,588
Default Fastest way to sort large 2-D arrays?

You could try loading your data into an ADO recordset and sorting it
there.
Google for "disconnected recordset" and ADO

Tim



"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is
about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too
big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'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

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS