Sorting contents of an array

  • Thread starter Thread starter Craig Wilks
  • Start date Start date
C

Craig Wilks

Is it possible to sort the contents of an array before loading the
array's contents into a combo box. If so, how is it performed. If not,
then is it possible to sort the contents of the combo box immediately
after loading it is completed?
Thanks for the help.
Craig Wilks
 
Here's an example using Quicksort from the archives

Sub QuickSort(SortArray, col, L, R)
'
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a a second dimension greater than 1 (or zero)
Dim i, j, X, Y, mm


i = L
j = R
X = SortArray((L + R) / 2, col)


While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
If (L < j) Then Call QuickSort(SortArray, col, L, j)
If (i < R) Then Call QuickSort(SortArray, col, i, R)
End Sub


Sub Tester1()
Set rng = Range("I7").CurrentRegion
vArr = rng.Value
QuickSort vArr, 5, LBound(vArr, 1), UBound(vArr, 1)
Range("I26").Resize(UBound(vAr­r, 1), UBound(vArr, 2)).Value = vArr
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
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 :
 
Back
Top