Dim UnSortedArray As Variant
Sub test()
Dim i As Long, j As Long, temp As Variant
Dim Pivot As Long, PivotPlace As Long
Dim Low As Long, High As Long
Dim Stack() As Long, StackPointer As Long
Dim rowArray() As Long, sortedArray As Variant
Rem get unsorted array, adjust
UnSortedArray = Range("A1:C6").Value
ReDim Stack(1 To 2, 0 To 0)
ReDim rowArray(LBound(UnSortedArray, 1) To UBound(UnSortedArray, 1))
For i = LBound(UnSortedArray, 1) To UBound(UnSortedArray, 1)
rowArray(i) = i
Next i
Low = LBound(rowArray): High = UBound(rowArray)
GoSub Push
Do Until StackPointer <= 0
GoSub Pop
i = (Low + High) / 2
temp = rowArray(i)
rowArray(i) = rowArray(High)
rowArray(High) = temp
Pivot = rowArray(High)
PivotPlace = Low
For i = Low To High - 1
If LT(rowArray(i), Pivot) Then
temp = rowArray(i)
rowArray(i) = rowArray(PivotPlace)
rowArray(PivotPlace) = temp
PivotPlace = PivotPlace + 1
End If
Next i
rowArray(High) = rowArray(PivotPlace)
rowArray(PivotPlace) = Pivot
i = Low: j = High
If Low < PivotPlace Then
High = PivotPlace - 1
GoSub Push
End If
If PivotPlace < j Then
High = j
Low = PivotPlace + 1
GoSub Push
End If
Loop
sortedArray = UnSortedArray
For i = LBound(UnSortedArray, 1) To UBound(UnSortedArray, 1)
For j = LBound(UnSortedArray, 2) To UBound(UnSortedArray, 2)
sortedArray(i, j) = UnSortedArray(rowArray(i), j)
Next j
Next i
Rem adjust output
Range("I1").Resize(UBound(sortedArray, 1), UBound(sortedArray, 2)).Value = sortedArray
Exit Sub
Push:
StackPointer = StackPointer + 1
If UBound(Stack, 2) < StackPointer Then ReDim Preserve Stack(1 To 2, 0 To 2 * StackPointer)
Stack(1, StackPointer) = Low
Stack(2, StackPointer) = High
Return
Pop:
Low = Stack(1, StackPointer)
High = Stack(2, StackPointer)
StackPointer = StackPointer - 1
Return
End Sub
Function LT(a As Long, b As Long) As Boolean
Dim col1 As Long, col2 As Long, col3 As Long
col1 = 1
col2 = 2
col3 = 3
If (UnSortedArray(a, col1) < UnSortedArray(b, col1)) Or (UnSortedArray(a, col1) = vbNullString) Then
LT = True
ElseIf (UnSortedArray(b, col1) < UnSortedArray(a, col1)) Or (UnSortedArray(b, col1) = vbNullString) Then
LT = False
Else
If UnSortedArray(a, col2) < UnSortedArray(b, col2) Then
LT = True
ElseIf UnSortedArray(b, col2) < UnSortedArray(a, col2) Then
LT = False
Else
LT = UnSortedArray(a, col3) < UnSortedArray(a, col3)
End If
End If
End Function