'автор кода Слэн (кажется)
Private Type QuickStack 'тип для QuickSort
 Low As Long
 High As Long
End Type

Public Sub sort_range(ByRef SortArray(), Optional ByVal col = 1)
On Error Resume Next
If UBound(SortArray, 2) > 2 Then Exit Sub
Dim i As Long, j As Long, lb As Long, ub As Long, dc&
Dim stack() As QuickStack, stackpos As Long, ppos As Long, pivot As Variant, swp, maxstack&
On Error GoTo er
lb = LBound(SortArray): ub = UBound(SortArray): dc = UBound(SortArray, 2) + 1 - col
ReDim stack(1 To 16)
stackpos = 1

stack(1).Low = lb
stack(1).High = ub
Do
 lb = stack(stackpos).Low 'Взять границы lb и ub текущего массива из стека.
 ub = stack(stackpos).High
 stackpos = stackpos - 1
 Do
 ppos = (lb + ub) \ 2 'Шаг 1. Разделение по элементу pivot
 i = lb: j = ub: pivot = SortArray(ppos, col)
 Do
 While SortArray(i, col) < pivot: i = i + 1: Wend
 While pivot < SortArray(j, col): j = j - 1: Wend
 If i > j Then Exit Do
 ' If i <> j Then
 swp = SortArray(i, col): SortArray(i, col) = SortArray(j, col): SortArray(j, col) = swp
 swp = SortArray(i, dc): SortArray(i, dc) = SortArray(j, dc): SortArray(j, dc) = swp
 ' End If
 i = i + 1
 j = j - 1
 ' End If
 Loop While i <= j

 If i < ppos Then 'правая часть больше
 If i < ub Then
 stackpos = stackpos + 1
 stack(stackpos).Low = i
 stack(stackpos).High = ub
 End If
 ub = j 'следующая итерация разделения будет работать с левой частью
 Else
 If j > lb Then
 stackpos = stackpos + 1
 stack(stackpos).Low = lb
 stack(stackpos).High = j
 End If
 lb = i
 End If
 ' If maxstack < stackpos Then maxstack = stackpos
 Loop While lb < ub
Loop While stackpos
Exit Sub
er: ReDim Preserve stack(1 To UBound(stack) * 2)
Resume
End Sub