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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub DbleSortTest()
'this is an amended version of a function on http://www.anthony-vba.kefra.com/vba/excelvba-simulation.htm
'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 String

    y(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 i

    MsgBox str
End Sub

You may also like