Bubble Sort

Bubble Sort uses a 'swapping' strategy to repeatedly swap the adjacent elements if they are in the wrong order.

Sub TestSort() 
Dim avTesting() As Variant
   avTesting = Array(2, 2, 1, 2, 2)
   Call Array_BubbleSort(avTesting)
   
   avTesting = Array(45, 30, 25, 15, 10, 5, 40, 20, 35, 50)
   Call Array_BubbleSort(avTesting)
   
   avTesting = Array(50, 45, 40, 35, 30, 25, 20, 15, 10, 5)
   Call Array_BubbleSort(avTesting)
   Stop
End Sub
Public Sub Array_BubbleSort(ByRef vArrayName As Variant, _ 
                   Optional ByVal lUpper As Long = -1, _
                   Optional ByVal lLower As Long = -1)

Dim vArrayResult1 As Variant
Dim vArrayResult2 As Variant
Dim vArrayResult3 As Variant
Dim vtemp As Variant
Dim i As Long
Dim j As Long
Dim bAllSwapped As Boolean
Dim inoofswaps As Integer
Dim inoofloops As Integer

   If IsEmpty(vArrayName) = True Then Exit Sub
   If lLower = -1 Then lLower = LBound(vArrayName, 1)
   If lUpper = -1 Then lUpper = UBound(vArrayName, 1)
   
'Algorithm 1
   vArrayResult1 = vArrayName
   inoofswaps = 0
   inoofloops = 0
   For i = lLower To (lUpper - 1)
      For j = (i + 1) To lUpper
         If (vArrayResult1(j) < vArrayResult1(i)) Then
            vtemp = vArrayResult1(i)
            vArrayResult1(i) = vArrayResult1(j)
            vArrayResult1(j) = vtemp
            inoofswaps = inoofswaps + 1
         End If
         inoofloops = inoofloops + 1
      Next j
   Next i
   Debug.Print "Algorithm 1 - swaps:" & inoofswaps & " loops:" & inoofloops
   
'Algorithm 2
   vArrayResult2 = vArrayName
   inoofswaps = 0
   inoofloops = 0
   For i = lLower To (lUpper - 1)
      For j = lLower To (lUpper - 1)
         If (vArrayResult2(j) > vArrayResult2(j + 1)) Then
            vtemp = vArrayResult2(j)
            vArrayResult2(j) = vArrayResult2(j + 1)
            vArrayResult2(j + 1) = vtemp
            inoofswaps = inoofswaps + 1
         End If
         inoofloops = inoofloops + 1
      Next j
   Next i
   Debug.Print "Algorithm 2 - swaps:" & inoofswaps & " loops:" & inoofloops
   
'Algorithm 3
   vArrayResult3 = vArrayName
   inoofswaps = 0
   inoofloops = 0
   Do
      bAllSwapped = False
      For j = lLower To (lUpper - 1)
         If (vArrayResult3(j) > vArrayResult3(j + 1)) Then
            vtemp = vArrayResult3(j)
            vArrayResult3(j) = vArrayResult3(j + 1)
            vArrayResult3(j + 1) = vtemp
            bAllSwapped = True
            inoofswaps = inoofswaps + 1
         End If
         inoofloops = inoofloops + 1
      Next j
      lUpper = lUpper - 1
   Loop Until bAllSwapped = False
   Debug.Print "Algorithm 3 - swaps:" & inoofswaps & " loops:" & inoofloops

'vArrayName = vArrayResult1
'vArrayName = vArrayResult2
   vArrayName = vArrayResult3
End Sub

© 2021 Better Solutions Limited. All Rights Reserved. © 2021 Better Solutions Limited TopPrevNext