What is the quickest way (in terms of computational time) to sort an array of numbers (1000-10000 numbers but could vary) in descending order? As far as I know the Excel build-in functions is not really efficient and in-memory sorting should be a lot faster than the Excel functions.
Note that I can not create anything on the spreadsheet, everything has to be stored and sorted in memory only.
You could use System.Collections.ArrayList:
Dim arr As Object
Dim cell As Range
Set arr = CreateObject("System.Collections.ArrayList")
' Initialise the ArrayList, for instance by taking values from a range:
For Each cell In Range("A1:F1")
arr.Add cell.Value
Next
arr.Sort
' Optionally reverse the order
arr.Reverse
This uses Quick Sort.
Just so that people don't have to click the link that I just did, here is one of the fantastic examples from Siddharth's comment.
Option Explicit
Option Compare Text
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngFirst As Long
Dim lngLast As Long
Dim varMid As Variant
Dim varSwap As Variant
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
End If
lngFirst = plngLeft
lngLast = plngRight
varMid = pvarArray((plngLeft + plngRight) \ 2)
Do
Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
lngFirst = lngFirst + 1
Loop
Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
lngLast = lngLast - 1
Loop
If lngFirst <= lngLast Then
varSwap = pvarArray(lngFirst)
pvarArray(lngFirst) = pvarArray(lngLast)
pvarArray(lngLast) = varSwap
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If plngLeft < lngLast Then QuickSort pvarArray, plngLeft, lngLast
If lngFirst < plngRight Then QuickSort pvarArray, lngFirst, plngRight
End Sub
If you want efficient algorithm, then take a look at Timsort. It is adaptation of merge sort that fixes it's problems.
Case Timsort Introsort Merge sort Quicksort Insertion sort Selection sort
Best Ɵ(n) Ɵ(n log n) Ɵ(n log n) Ɵ(n) Ɵ(n^2) Ɵ(n)
Average Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n^2) Ɵ(n^2)
Worst Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n^2) Ɵ(n^2) Ɵ(n^2)
However 1k - 10k data entries are far too little amount of data for you to worry about built in search efficiency.
Example : If you have data from column A to D and header is at row 2 and you want to sort by column B.
Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A3:D" & lastrow).Sort key1:=Range("B3:B" & lastrow), _
order1:=xlAscending, Header:=xlNo
I have used the Shell sort algorithm successfully. Runs in the blink of an eye when tested for N=10000 using an array generated with VBA Rnd() function - don't forget to use the Randomize statement for generating test arrays. It was easy to implement and short and efficient enough for the number of elements I was dealing with. Reference is given in the code comments.
' Shell sort algorithm for sorting a double from largest to smallest.
' Adopted from "Numerical Recipes in C" aka NRC 2nd Edition p330ff.
' Speed is on the range of N^1.25 to N^1.5 (somewhere between bubble and quicksort)
' Refer to the NRC reference for more details on efficiency.
'
Private Sub ShellSortDescending(ByRef a() As Double, N As Integer)
' requires a(1..N)
Debug.Assert LBound(a) = 1
' setup
Dim i, j, inc As Integer
Dim v As Double
inc = 1
' determine the starting incriment
Do
inc = inc * 3
inc = inc + 1
Loop While inc <= N
' loop over the partial sorts
Do
inc = inc / 3
' Outer loop of straigh insertion
For i = inc + 1 To N
v = a(i)
j = i
' Inner loop of straight insertion
' switch to a(j - inc) > v for ascending
Do While a(j - inc) < v
a(j) = a(j - inc)
j = j - inc
If j <= inc Then Exit Do
Loop
a(j) = v
Next i
Loop While inc > 1
End Sub
I know the OP specified not using worksheets but its worth noting that creating a new WorkSheet, using it as a scratch pad to do the sort with worksheet functions, then cleaning up after is longer by less than a factor of 2. But you also have all of the flexibility delivered by the parameters of the Sort WorkSheet Function.
On my system, the difference was 55 msec for the very nice recursive routine by @tannman357 and 96 msec for the method below. Those are average times over several runs.
Sub rangeSort(ByRef a As Variant)
Const myName As String = "Module1.rangeSort"
Dim db As New cDebugReporter
db.Report caller:=myName
Dim r As Range, va As Variant, ws As Worksheet
quietMode qmON
Set ws = ActiveWorkbook.Sheets.Add
Set r = ws.Cells(1, 1).Resize(UBound(a), 1)
r.Value2 = rangeVariant(a)
r.Sort Key1:=r.Cells(1), Order1:=xlDescending
va = r.Value2
GetColumn va, a, 1
ws.Delete
quietMode qmOFF
End Sub
Function rangeVariant(a As Variant) As Variant
Dim va As Variant, i As Long
ReDim va(LBound(a) To UBound(a), 0)
For i = LBound(a) To UBound(a)
va(i, 0) = a(i)
Next i
rangeVariant = va
End Function
Sub quietMode(state As qmState)
Static currentState As Boolean
With Application
Select Case state
Case qmON
currentState = .ScreenUpdating
If currentState Then .ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
Case qmOFF
If currentState Then .ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
Case Else
End Select
End With
End Sub
I answered this question myself a long time ago, meaning I had to come back to my very first VBA archived files. So I found this old code, which I took from a book. First it saves values (from selection intersected with a table column) to array ar(x) then sort them from smallest to biggest. To sort there are 2 bucles, the first one (Do Loop Until sw=0) and the second one (For x=1 To n Next) compares value a(x) with value a(x+1), keeping in a(x) the biggest number and in ar(x+1) the smallest number. The first bucle repeats until is sorted form smallest to biggest. I actually used this code to insert a rows above every selected cell in a budget column (TblPpto[Descripcion]). Hope it helps!
Sub Sorting()
Dim ar() As Integer, AX As Integer
Set rng = Intersect(Selection, Range("TblPpto[Descripcion]")) 'Cells selected in Table column
n = rng.Cells.Count 'Number of rows
ReDim ar(1 To n)
x = 1
For Each Cell In rng.Cells
ar(x) = Cell.Row 'Save rows numbers to array ar()
x = x + 1
Next
Do 'Sort array ar() values
sw = 0 'Condition to finish bucle
For x = 1 To n - 1
If ar(x) > ar(x + 1) Then 'If ar(x) is bigger
AX = ar(x) 'AX gets bigger number
ar(x) = ar(x + 1) 'ar(x) changes to smaller number
ar(x + 1) = AX 'ar(x+1) changes to bigger number
sw = 1 'Not finished sorting
End If
Next
Loop Until sw = 0
'Insert rows in TblPpto
fila = Range("TblPpto[#Headers]").Row
For x = n To 1 Step -1
[TblPpto].Rows(ar(x) - fila).EntireRow.Insert
Next x
End Sub
The trincot code simply expanded as a function. Have fun with that!
Function sort1DimArray(thatArray As Variant, descending As Boolean) As Variant
Dim arr As Object, i As Long, j As Long`
Set arr = CreateObject("System.Collections.ArrayList")
For i = LBound(thatArray) To UBound(thatArray)
arr.Add thatArray(i)
Next i
arr.Sort
If descending = True Then
arr.Reverse
End If
'shortens empty spaces
For i = 0 To (arr.count - 1)
If Not IsEmpty(arr.Item(i)) Then
thatArray(j) = arr.Item(i)
j = j + 1
End If
Next i
ReDim Preserve thatArray(0 To (j - 1))
sort1DimArray = thatArray
End Function
