Called like:
dim v
v=range("a1:b60").value
doquicksort v
combobox1.list = v
If you need more options on the quicksort, there's plenty of similar
routines out there. Just search on 'quicksort'
Public Sub DoQuickSort(vArr, Optional n& = True, Optional m& = True)
'Classic quicksort
'Sorts an 1 or 2 dimensional array in ascending order
'Will not proces Ranges.
Static d%: Dim i&, j&, p, t
If n = True Or m = True Then
d = GetArrayDimensions(vArr)
n = LBound(vArr): m = UBound(vArr)
End If
If d = 1 Then
'One dimension
i = n: j = m: p = vArr((n + m) \ 2)
While (i <= j)
While (vArr(i) < p And i < m): i = i + 1: Wend
While (vArr(j) > p And j > n): j = j - 1: Wend
If (i <= j) Then
t = vArr(i): vArr(i) = vArr(j): vArr(j) = t
i = i + 1: j = j - 1
End If
Wend
ElseIf d > 1 Then
'Two dimensions
i = n: j = m: p = vArr((n + m) \ 2, 1)
While (i <= j)
While (vArr(i, 1) < p And i < m): i = i + 1: Wend
While (vArr(j, 1) > p And j > n): j = j - 1: Wend
If (i <= j) Then
t = vArr(i, 1): vArr(i, 1) = vArr(j, 1): vArr(j, 1) = t
i = i + 1: j = j - 1
End If
Wend
Else
Exit Sub
End If
If (n < j) Then DoQuickSort vArr, n, j
If (i < m) Then DoQuickSort vArr, i, m
End Sub
Public Function GetArrayDimensions(vArr As Variant) As Integer
'Returns the dimensions of an array
Dim i%
On Error Resume Next
If TypeName(vArr) = "Range" Then
i = -2
ElseIf Not IsArray(vArr) Then
i = -1
Else
For i = 0 To 59
If IsError(LBound(vArr, i + 1)) Then Exit For
Next
End If
GetArrayDimensions = i
End Function
--
keepITcool
|
www.XLsupport.com | keepITcool chello nl | amsterdam
Craig Wilks wrote :