Problem sorting 2-D array

[RB Smissaert]

Need to sort large 2-D arrays.
For this I always used the following routine:

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 Resume Next

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

End Sub

Now have come across an array where this routine fails. This array was about
24000 rows and 2 columns.
When I leave out the On Error Resume Next I get an error out of stackspace
at the line:
If iHigh2 > iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2
iLow1 will be something like 10000.

Would there be any way to avoid the above error or would there be a better
sorting routine?
I can't sort in the sheet as the rows can be more than 65536.
Thanks for any advice.


RBS

 

[RB Smissaert]

Found one solution to this problem, that works for now, although it doesn't
look
very elegant and it may fail on even larger arrays.
The idea is to sort ever increasing parts of the array till finally the
whole array gets sorted:

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

'the routine procSort2D can't handle large arrays
'causing an error out of stack space
'this is handled by sorting increasing larger parts
'of the array, so that there is less to be done when
'the whole array gets sorted
'---------------------------------------------------

Dim LR As Long
Dim lPreSorts As Long
Dim lArrayChunk As Long
Dim n As Long

LR = UBound(avArray)

'this value may depend on the hardware
'-------------------------------------
lArrayChunk = 10000

'no need to do pre-sorts
'-----------------------
If LR < lArrayChunk Then
procSort2D avArray, _
sOrder, _
iKey, _
iLow1, _
iHigh1
Exit Sub
End If

lPreSorts = LR \ lArrayChunk

For n = 0 To lPreSorts
If n < lPreSorts Then
'increase the part of the array in steps of lArrayChunk
'------------------------------------------------------
procSort2D avArray, _
sOrder, _
iKey, _
iLow1, _
(n + 1) * lArrayChunk
Else
'sort the whole array
'--------------------
procSort2D avArray, _
sOrder, _
iKey, _
iLow1, _
iHigh1
End If
Next

End Sub

If this indeed works I think the line On Error Resume Next can be left out
of the
array sorting Sub.


RBS