 # 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
```