Dim LStack() As Long, HStack() As Long
Dim SPointer As Long

Sub test() 'option from mikerickson
Dim xRRay As Variant
With Sheets("Sheet1").Range("A:A")
 With Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 xRRay = Application.Transpose(.Value)
 SortArray xRRay, True
 .Offset(0, 1).Value = Application.Transpose(xRRay)
 End With
End With
End Sub

Sub SortArray(ByRef myArray As Variant, Descending As Boolean)
Dim Low As Long, High As Long
Dim LookingAt As Long, PivotPlace As Long
Dim pivotVal As Variant
Dim pivotChoosing As Boolean

Low = LBound(myArray)
High = UBound(myArray)
Push Low, High

Do Until SPointer <= 0
 Pop Low, High
 'If pivotChoosing Then
 Swap myArray, High, (Low + High) / 2
 'End If

 pivotVal = myArray(High)
 PivotPlace = Low
 For LookingAt = Low To High - 1
 If LT(myArray(LookingAt), pivotVal) Xor Descending Then
 Swap myArray, PivotPlace, LookingAt
 PivotPlace = PivotPlace + 1
 End If
 Next LookingAt
 Swap myArray, High, PivotPlace

 If Low < PivotPlace - 1 Then Push Low, PivotPlace - 1
 If PivotPlace + 1 < High Then Push PivotPlace + 1, High
Loop
End Sub
Sub Swap(ByRef inRRay As Variant, A As Long, B As Long)
 Dim temp As Variant
 temp = inRRay(A)
 inRRay(A) = inRRay(B)
 inRRay(B) = temp
End Sub
Sub Push(ByRef A As Long, ByRef B As Long)
 SPointer = SPointer + 1
 On Error GoTo EnlargeStack
 
 LStack(SPointer) = A
 HStack(SPointer) = B
 Exit Sub
EnlargeStack:
 Err.Clear
 On Error GoTo InitializeStack
 ReDim Preserve LStack(0 To 2 * SPointer)
 ReDim Preserve HStack(0 To 2 * SPointer)
 Resume
InitializeStack:
 Err.Clear
 ReDim LStack(0 To 0)
 ReDim HStack(0 To 0)
 SPointer = 1
 Resume
End Sub
Sub Pop(ByRef A As Long, B As Long)
 A = LStack(SPointer)
 B = HStack(SPointer)
 SPointer = SPointer - 1
End Sub
Function LT(A As Variant, B As Variant) As Boolean
 LT = A < B
End Function