VBA Snippets – Sorting Arrays and Random Selection
The blog post sounds a little Darwinian but I’m afraid it’s just a dull selection of VBA code that enables you to sort one array on the basis of values from another. A double sorting array.
I’ve amended array sorting code from John Walkenbach and Anthony’s VBA Tutorials to create something I can understand.
The DbleBubbleSort routine takes two arrays as arguments and sorts the string array (y) on the basis of the values in a nuber array (x). I’m using John Walkenbachs BubbleSort methodology which is simple but undoubtedly not the most efficient.
Sub DbleBubbleSort(x() As Single, y() As String)
‘ adapting the BubbleSort method to sort an array on the basis of the values in another array.
‘ x is an array of numbers (can be random as in the DbleSortTest() routine)
‘ y is a string array
Dim First As Integer, Last As Long
Dim i As Long, j As Long
Dim xtemp As Single
Dim ytemp As String
First = LBound(x)
Last = UBound(x)
For i = First To Last – 1
For j = i + 1 To Last
If x(i) > x(j) Then
xtemp = x(j)
ytemp = y(j)
x(j) = x(i)
y(j) = y(i)
x(i) = xtemp
y(i) = ytemp
End If
Next j
Next i
End Sub
The following routine calls on the DbleBubbleSort sub routine and uses it to provide a random selection of 3 entries from a string array.
Sub DbleSortTest()
‘this is an amended version of a function on http://www.anthony-vba.kefra.com/vba/excelvba-simulation.htm#Creating_and_Managing_Array
‘it randomly selects 3 entries from a text array (y)
‘it utilises a random number array and the sorting of one array based on the values in another.Dim i As Long
Dim x(8) As Single, y(8) As String
Dim str As Stringy(1) = “Anthony”
y(2) = “Bobby”
y(3) = “Chris”
y(4) = “Danny”
y(5) = “Eton”
y(6) = “Frank”
y(7) = “George”
y(8) = “Harry”
‘enters the x array into a worksheet
For i = 1 To UBound(x)
x(i) = Rnd
Cells(i, 2) = x(i)
Next i
‘enters the y array in column 3 of the worksheet
For i = 1 To UBound(y)
Cells(i, 3) = y(i)
Next i
Call DbleBubbleSort(x, y)
‘calls the first 3 values of y sorted according to x and enters them in the worksheet
str = “”
For i = 1 To 3
str = str & y(i) & vbCrLf
Cells(i, 1) = y(i)
Next iMsgBox str
End Sub



