VBA Snippets to Sort Arrays in VBA

Here’s another VBA snippet post. I find it handy to have a store of regularly used macros on the blog so I can access them at any time, not that I need them that often of course.

These particular snippets are useful routines for sorting arrays and can be called from other procedures. I’ve taken these particular ones from John Walkenbach’s book: Excel 2007 Power Programming with VBA. I’m working my way through Anthony’s VBA tutorials for excel modelling and array sorting is regular feature.

The BubbleSort code is easy to understand and therefore one of my favourites but the other 3 methods are much quicker for arrays with more than 500 entries.

Sub BubbleSort(list() As String)
‘ Taken from power programming with VBA
‘ It’s a sorting procedure for 1-dimensional arrays named List
‘ The procedure takes each array element, if it is greater than the next element, the two elements swap positions.
‘ The evaluation is repeated for every pair of items (that is n-1 times)
‘ Change data type to As Integer if your array isn’t text
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim temp As String
    First = LBound(list)
    Last = UBound(list)
    For i = First To Last – 1
        For j = i + 1 To Last
            If list(i) > list(j) Then
                temp = list(j)
                list(j) = list(i)
                list(i) = temp
            End If
        Next j
    Next i
End Sub

You can test this macro with the following routine which pastes the results into the immediate window.

Sub SortTester()
   
    Dim x(1 To 5) As String
    Dim i As Long
   
    x(1) = “egg”
    x(2) = “apple”
    x(3) = “stuff”
    x(4) = “nonsense”
    x(5) = “1″
   
    Call BubbleSort(x)
   
    For i = 1 To 5
        Debug.Print i, x(i)
    Next i
End Sub

Here are a few more sort options which are a bit more efficient but unfortunately more complex.

Sub WorksheetSort(list)
‘   Sorts an array by transferring it to
‘   A worksheet and using Excel’s sorting command
   
    Dim First As Integer, Last As Long
    Dim i As Long
    Dim FirstCell As Range, LastCell As Range
    Dim CurrCell As Range, FillRange As Range
   
    First = LBound(list, 1)
    Last = UBound(list, 1)
    Set FirstCell = Sheets(“Sheet1″).Cells(1, 1)
    Set LastCell = Sheets(“Sheet1″).Cells(Last, 1)
    Set FillRange = Range(FirstCell, LastCell)
    Application.ScreenUpdating = False
   
‘   Transfer the array to worksheet
    FillRange.Value = list
   
‘   Sort the worksheet range
    FirstCell.CurrentRegion.Sort Key1:=FirstCell, Order1:=xlAscending, Orientation:=xlTopToBottom
      
‘   Transfer range back to the array and clear range
    For i = First To Last
        list(i, 0) = FirstCell.Offset(i – 1, 0)
    Next i
    FillRange.Clear
    Application.ScreenUpdating = True
End Sub

Public Sub Quicksort(list() As Long, ByVal min As Long, ByVal max As Long) 
‘This technique works only with Integer or Long values.
Dim med_value As Long
    Dim hi As Long
    Dim lo As Long
    Dim i As Long

    ‘ If min >= max, the list contains 0 or 1 items so it
    ‘ is sorted.
    If min >= max Then Exit Sub

    ‘ Pick the dividing value.
    i = Int((max – min + 1) * Rnd + min)
    med_value = list(i)

    ‘ Swap it to the front.
    list(i) = list(min)

    lo = min
    hi = max
    Do
        ‘ Look down from hi for a value < med_value.
        Do While list(hi) >= med_value
            hi = hi – 1
            If hi <= lo Then Exit Do
        Loop
        If hi <= lo Then
            list(lo) = med_value
            Exit Do
        End If

        ‘ Swap the lo and hi values.
        list(lo) = list(hi)
       
        ‘ Look up from lo for a value >= med_value.
        lo = lo + 1
        Do While list(lo) < med_value
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop
        If lo >= hi Then
            lo = hi
            list(hi) = med_value
            Exit Do
        End If
       
        ‘ Swap the lo and hi values.
        list(hi) = list(lo)
    Loop
   
    ‘ Sort the two sublists.
    Quicksort list(), min, lo – 1
    Quicksort list(), lo + 1, max
End Sub

Sub Countingsort(list)
‘This technique works only with Integer or Long values.
Dim counts()
    Dim i As Long
    Dim j As Long
    Dim next_index As Long
    Dim min, max
    Dim min_value As Variant, max_value As Variant

‘   Allocate the counts array. VBA automatically
‘   initialises all entries to 0.

    min_value = Minimum(list)
    max_value = Maximum(list)

    min = LBound(list)
    max = UBound(list)
   
    ReDim counts(min_value To max_value)
   
    ‘ Count the values.
    For i = min To max
        counts(list(i)) = counts(list(i)) + 1
    Next i

    ‘ Write the items back into the list array.
    next_index = min
    For i = min_value To max_value
        For j = 1 To counts(i)
            list(next_index) = i
            next_index = next_index + 1
        Next j
    Next i
End Sub

Function Minimum(list)
    Dim i As Long
    Minimum = list(LBound(list))
    For i = LBound(list) To UBound(list)
        If list(i) < Minimum Then Minimum = list(i)
    Next i
End Function

Function Maximum(list)
    Dim i As Long
    Maximum = list(LBound(list))
    For i = LBound(list) To UBound(list)
        If list(i) > Maximum Then Maximum = list(i)
    Next i
End Function

Tags: arrays, sorting, VBA