Quicksort for multi-columns

[Joakim Norrman]

I want to sort a 2D-array. I have found Quicksort code but only for a
one-dimensional array. Do anyone know where to find a sort routine for
2D-arrays? I want a quick method. Not Bubble sort.

 

[RB Smissaert]

Try this one:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) > varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) > varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
varTempVal = VarArray(lngLow, lSortColumn)
VarArray(lngLow, 1) = VarArray(lngHigh, lSortColumn)
VarArray(lngHigh, 1) = varTempVal
lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If
Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then QuickSort2DArray VarArray, lSortColumn, sOrder,
lngFirst, lngHigh
If lngLow < lngLast Then QuickSort2DArray VarArray, lSortColumn, sOrder,
lngLow, lngLast

End Function


RBS

 

[RB Smissaert]

I had quickly edited a bit of code and forgot to alter something else.
This is how it should be:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim c As Long
Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) > varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) > varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
'swap the array rows
'-------------------
For c = LBound(VarArray, 2) To UBound(VarArray, 2)
varTempVal = VarArray(lngLow, c)
VarArray(lngLow, c) = VarArray(lngHigh, c)
VarArray(lngHigh, c) = varTempVal
Next c

lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If

Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngFirst, _
lngHigh
End If

If lngLow < lngLast Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngLow, _
lngLast
End If

End Function


RBS

 

[Joakim Norrman]

Thanks RB. Appreciate your help.

I had quickly edited a bit of code and forgot to alter something else.
This is how it should be:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim c As Long
Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) > varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) > varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
'swap the array rows
'-------------------
For c = LBound(VarArray, 2) To UBound(VarArray, 2)
varTempVal = VarArray(lngLow, c)
VarArray(lngLow, c) = VarArray(lngHigh, c)
VarArray(lngHigh, c) = varTempVal
Next c

lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If

Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngFirst, _
lngHigh
End If

If lngLow < lngLast Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngLow, _
lngLast
End If

End Function


RBS

 

[Bernd P]

Hello,

Please note that quicksort is not stable.

Maybe you would like to get mergesort or some other stable n * log(n)
algorithm...

Regards,
Bernd