Awesome

Sorting Algorithms

#back



The Bubble Sort

Bubble sort, sometimes incorrectly referred to as sinking sort, is a simple sorting algorithm that works by repeatedly stepping through the list to be sorted, comparing each pair of adjacent items and swapping them if they are in the wrong order. The pass through the list is repeated until no swaps are needed, which indicates that the list is sorted. The algorithm gets its name from the way smaller elements "bubble" to the top of the list. The Bubble sort is a slow sorting method when used on larger data sets and much slower than a Comb sort - read more about the Bubble sort on Wikipedia

The Functions will sort both numeric and text data with the numerical data sorting before text data. It will correctly sort "1,1,1,11,111" etc. It will correctly sort Dates ie. "01/12/2013, 12/10/2018, 01/09/2012". I have given you 1D Array and 2D Worksheet Array Functions together with examples of how to use the Functions including dynamic and hard-coded Ranges:

' force explicit variable declaration
Option Explicit

' Case-Insensitive - based on order in the ASCII table
' Performs a textual string comparison (A = a)
Option Compare Text

' Used at module level to declare the default lower bound for array subscripts
Option Base 1


' ## 1D Array Bubble sort
Sub BubbleSortExample()

    ' array
    Dim v As Variant
    v = BubbleSort(Array("Rabbit", "Cat", "Dog"), True)

End Sub

' ## 2D Worksheet array Bubble sort
Sub BubbleSort2DExample()

    ' dynamic Range, sort from "A1" to the first blank Cell
    Range(Range("A1"), Range("A1").End(xlDown)) = _
    BubbleSort2D((Range(Range("A1"), Range("A1").End(xlDown))), False)

    ' dynamic Range, sort from "A1" to the last Blank Row
    'Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row) = _
    'BubbleSort2D((Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)), False)

    ' hard-coded Range
    'Range("A1:A16") = BubbleSort2D((Range("A1:A16")), True)
    '[A1:A16] = BubbleSort2D((Range("A1:A16")), True)

End Sub

' ## BubbleSort, array bubble sort.  returns a sorted list according to the sort direction
Private Function BubbleSort(ByVal List As Variant, ByVal Ascending As Boolean) As Variant
    Dim i#, j#, v
    For i = 1 To UBound(List)
        For j = i + 1 To UBound(List)
            ' exclusive logical disjunction of two Boolean values
            If List(j) > List(i) Xor Ascending Then
                v = List(j)
                List(j) = List(i)
                List(i) = v
            End If
        Next j
    Next i
    BubbleSort = List
End Function

' ## BubbleSort2D, 2 dimensional array bubble sort.  returns a sorted list according to the sort direction
Private Function BubbleSort2D(ByVal List As Variant, ByVal Ascending As Boolean) As Variant
    Dim i#, j#, v
    For i = 1 To UBound(List)
        For j = i + 1 To UBound(List)
            ' exclusive logical disjunction of two Boolean values
            If List(j, 1) > List(i, 1) Xor Ascending Then
                v = List(j, 1)
                List(j, 1) = List(i, 1)
                List(i, 1) = v
            End If
        Next j
    Next i
    BubbleSort2D = List
End Function



The Comb Sort

Comb sort is a relatively simplistic sorting algorithm. It improves on bubble sort and rivals algorithms like Quicksort. The basic idea is to eliminate turtles, or small values near the end of the list, since in a bubble sort these slow the sorting down tremendously. Rabbits, large values around the beginning of the list, do not pose a problem in bubble sort. In bubble sort, when any two elements are compared, they always have a gap (distance from each other) of 1. The basic idea of comb sort is that the gap can be much more than 1. The pattern of repeated sorting passes with decreasing gaps is similar to Shellsort. Comb sort's passes do not completely sort the elements - read more about the Comb sort on Wikipedia

The Functions will sort both numeric and text data with the numerical data sorting before text data. It will correctly sort "1,1,1,11,111" etc. It will correctly sort Dates ie. "01/12/2013, 12/10/2018, 01/09/2012". I have given you 1D Array and 2D Worksheet Array Functions together with examples of how to use the Functions including dynamic and hard-coded Ranges:

' force explicit variable declaration
Option Explicit

' Case-Insensitive - based on order in the ASCII table
' Performs a textual string comparison (A = a)
Option Compare Text

' Used at module level to declare the default lower bound for array subscripts
Option Base 1


' ## 1D Array Comb sort
Sub CombSortExample()

    ' array
    Dim v As Variant
    v = CombSort(Array("Rabbit", "Cat", "Dog"), True)

End Sub

' ## 2D Worksheet array Comb sort
Sub CombSort2DExample()

    ' dynamic Range, sort from "A1" to the first blank Cell
    Range(Range("A1"), Range("A1").End(xlDown)) = _
    CombSort2D((Range(Range("A1"), Range("A1").End(xlDown))), True)

    ' dynamic Range, sort from "A1" to the last Blank Row
    'Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row) = _
    'CombSort2D((Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)), True)

    ' hard-coded the Range
    'Range("A1:A16") = CombSort2D((Range("A1:A16")), True)
    '[A1:A16] = CombSort2D((Range("A1:A16")), True)

End Sub

' ## CombSort, array comb sort.  returns a sorted list according to the sort direction
Private Function CombSort(ByVal List As Variant, ByVal Ascending As Boolean)
    Dim i#, j, gap#
    Dim swapped As Boolean
    gap = UBound(List) - 1
    Do While gap > 1 Or swapped
        If gap > 1 Then gap = (10 * gap) \ 13
        If gap = 9 Or gap = 10 Then gap = 11
        swapped = False
        For i = 1 To UBound(List) - gap
            If Ascending And List(i) > List(i + gap) Then
                j = List(i)
                List(i) = List(i + gap)
                List(i + gap) = j
                swapped = True
            ElseIf Not Ascending And List(i) < List(i + gap) Then
                j = List(i)
                List(i) = List(i + gap)
                List(i + gap) = j
                swapped = True
            End If
        Next i
    Loop
    CombSort = List
End Function

' ## CombSort2D, 2 dimensional array comb sort.  returns a sorted list according to the sort direction
Private Function CombSort2D(ByVal List As Variant, ByVal Ascending As Boolean)
    Dim i#, j, gap#
    Dim swapped As Boolean
    gap = UBound(List) - 1
    Do While gap > 1 Or swapped
        If gap > 1 Then gap = (10 * gap) \ 13
        If gap = 9 Or gap = 10 Then gap = 11
        swapped = False
        For i = 1 To UBound(List) - gap
            If Ascending And List(i, 1) > List(i + gap, 1) Then
                j = List(i, 1)
                List(i, 1) = List(i + gap, 1)
                List(i + gap, 1) = j
                swapped = True
            ElseIf Not Ascending And List(i, 1) < List(i + gap, 1) Then
                j = List(i, 1)
                List(i, 1) = List(i + gap, 1)
                List(i + gap, 1) = j
                swapped = True
            End If
        Next i
    Loop
    CombSort2D = List
End Function



The Heap Sort

Heapsort is a comparison-based sorting algorithm to create a sorted array (or list), and is part of the selection sort family. Heapsort primarily competes with quicksort, another very efficient general purpose nearly-in-place comparison-based sort algorithm. Heapsort is a two step algorithm. The first step is to build a heap out of the data. The second step begins with removing the largest element from the heap. We insert the removed element into the sorted array. For the first element, this would be position 0 or 1 of the array (depending on the bounds index used ie. Option Base 0 or Option Base 1). Next we reconstruct the heap and remove the next largest item, and insert it into the array. After we have removed all the objects from the heap, we have a sorted array

The Function takes 2 Parameters. Parameter 1 (Variant) is a single Variant Array containing the unordered data list. Parameter 2 (Boolean data type) is the sort direction which can be either True:=Ascending or False:=Descending. The Return Result is a sorted single Variant Array. This sorting algorithm will sort both Numerical and Text data (NB: Numbers will be sorted before Text and AAA will be sorted before aaa)

' force explicit variable declaration
Option Explicit

' Case-Insensitive - based on order in the ASCII table
' Performs a textual string comparison (A = a)
Option Compare Text

' Used at module level to declare the default lower bound for array subscripts
Option Base 1

' ## 2D Worksheet array Heap sort
'    - output to a different Range!
Sub HeapSort2DExample()

    ' dynamic Range, sort from "A1" to the first blank Cell
    Dim vntArray As Variant
    vntArray = HeapSort2D((Range(Range("A1"), Range("A1").End(xlDown))), True)
    Range("B1").Resize(UBound(vntArray)) = vntArray

    ' dynamic Range, sort from "A1" to the last Blank Row, Blanks will be sorted to the Top
    'Dim vntArray As Variant
    'vntArray = HeapSort2D((Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)), True)
    'Range("B1").Resize(UBound(vntArray)) = vntArray

    ' hard-coded the Range
    'Range("B1:B16") = HeapSort2D((Range("A1:A16")), True)
    '[B1:B16] = HeapSort2D((Range("A1:A16")), True)

End Sub

' ## HeapSort2D, 2 dimensional array heap sort.  returns a sorted list according to the sort direction
Private Function HeapSort2D(ByVal List As Variant, ByVal Ascending As Boolean)

    Dim j, k, the_end#
    k = UBound(List)
    heapify2D List, k, Ascending

    the_end = k
    While the_end >= 1
        j = List(the_end, 1)
        List(the_end, 1) = List(1, 1)
        List(1, 1) = j
        the_end = the_end - 1
        siftDown2D List, 1, the_end, Ascending
    Wend

    HeapSort2D = List

End Function

Private Function heapify2D(ByRef List As Variant, ByVal Count#, ByVal Ascending As Boolean)

    Dim start#
    start = (Count - 2) / 2

    While start > 0
        siftDown2D List, start, Count - 1, Ascending
        start = start - 1
    Wend

End Function

Private Function siftDown2D(ByRef List As Variant, ByVal the_start#, ByVal the_end#, ByVal Ascending As Boolean)

    Dim k, root, child, swap#
    root = the_start

    While root * 2 <= the_end
        child = root * 2
        swap = root

        If Ascending Then
            If List(swap, 1) < List(child, 1) Then
                swap = child
            End If
            If child + 1 <= the_end And List(swap, 1) < List(child + 1, 1) Then
                swap = child + 1
            End If
        Else
            If List(child, 1) < List(swap, 1) Then
                swap = child
            End If
            If child + 1 <= the_end And List(child + 1, 1) < List(swap, 1) Then
                swap = child + 1
            End If
        End If

        If swap <> root Then
            k = List(root, 1)
            List(root, 1) = List(swap, 1)
            List(swap, 1) = k
            root = swap
        Else
            Exit Function
        End If

    Wend

End Function