VBA Bubble Sort Algorithm Slow

Question

I am surprised at how slow this bubble sort algorithm is using VBA. So my question is am I doing something wrong/inefficient, or is this just the best VBA and bubble sort wi

Answer 1

Here is my implementation of quicksort for anyone interested. I am sure the code could be cleaned up quite a but, but here is a good start. This code sorted 10,000 rows in less then a second.

 Option Explicit


  ' QuickSort for 2D array in form Array(cols,rows)
  ' Enter in 1, 2, or 3 columns to sort by, each can be either asc or desc
Public Sub QuickSortStart(ThisArray As Variant, sortColumn1 As Integer, asc1 As Boolean, Optional sortColumn2 As Integer = -1, Optional asc2 As Boolean = True, Optional sortColumn3 As Integer = -1, Optional asc3 As Boolean = True)

    Dim LowerBound As Integer
    Dim UpperBound As Integer

    LowerBound = LBound(ThisArray, 2)
    UpperBound = UBound(ThisArray, 2)

    Call QuickSort(ThisArray, LowerBound, UpperBound, sortColumn1, asc1, sortColumn2, asc2, sortColumn3, asc3)

End Sub


Private Sub QuickSort(ThisArray As Variant, FirstRow As Integer, LastRow As Integer, sortColumn1 As Integer, asc1 As Boolean, sortColumn2 As Integer, asc2 As Boolean, sortColumn3 As Integer, asc3 As Boolean)

    Dim pivot1 As Variant
    Dim pivot2 As Variant
    Dim pivot3 As Variant
    Dim tmpSwap As Variant
    Dim tmpFirstRow  As Integer
    Dim tmpLastRow   As Integer
    Dim FirstCol As Integer
    Dim LastCol As Integer
    Dim i As Integer

    tmpFirstRow = FirstRow
    tmpLastRow = LastRow
    FirstCol = LBound(ThisArray, 1)
    LastCol = UBound(ThisArray, 1)

    pivot1 = ThisArray(sortColumn1, (FirstRow + LastRow) \ 2)
    If sortColumn2 <> -1 Then
        pivot2 = ThisArray(sortColumn2, (FirstRow + LastRow) \ 2)
    End If
    If sortColumn3 <> -1 Then
        pivot3 = ThisArray(sortColumn3, (FirstRow + LastRow) \ 2)
    End If

    While (tmpFirstRow <= tmpLastRow)

        While (compareFirstLoop(ThisArray, pivot1, pivot2, pivot3, tmpFirstRow, sortColumn1, asc1, sortColumn2, asc2, sortColumn3, asc3) And tmpFirstRow < LastRow)
            tmpFirstRow = tmpFirstRow + 1
        Wend

        While (compareSecondLoop(ThisArray, pivot1, pivot2, pivot3, tmpLastRow, sortColumn1, asc1, sortColumn2, asc2, sortColumn3, asc3) And tmpLastRow > FirstRow)
            tmpLastRow = tmpLastRow - 1
        Wend

        If (tmpFirstRow <= tmpLastRow) Then
            For i = FirstCol To LastCol
                tmpSwap = ThisArray(i, tmpFirstRow)
                ThisArray(i, tmpFirstRow) = ThisArray(i, tmpLastRow)
                ThisArray(i, tmpLastRow) = tmpSwap
            Next i
            tmpFirstRow = tmpFirstRow + 1
            tmpLastRow = tmpLastRow - 1
        End If
    Wend

    If (FirstRow < tmpLastRow) Then
        Call QuickSort(ThisArray, FirstRow, tmpLastRow, sortColumn1, asc1, sortColumn2, asc2, sortColumn3, asc3)
    End If

    If (tmpFirstRow < LastRow) Then
        Call QuickSort(ThisArray, tmpFirstRow, LastRow, sortColumn1, asc1, sortColumn2, asc2, sortColumn3, asc3)
    End If

End Sub



Private Function compareFirstLoop(ThisArray As Variant, pivot1 As Variant, pivot2 As Variant, pivot3 As Variant, checkRow As Integer, sortColumn1 As Integer, asc1 As Boolean, sortColumn2 As Integer, asc2 As Boolean, sortColumn3 As Integer, asc3 As Boolean)

    If asc1 = True And ThisArray(sortColumn1, checkRow) < pivot1 Then
        compareFirstLoop = True
    ElseIf asc1 = False And ThisArray(sortColumn1, checkRow) > pivot1 Then
        compareFirstLoop = True

    'Move to Second Column
    ElseIf sortColumn2 <> -1 And ThisArray(sortColumn1, checkRow) = pivot1 Then
        If asc2 = True And ThisArray(sortColumn2, checkRow) < pivot2 Then
            compareFirstLoop = True
        ElseIf asc2 = False And ThisArray(sortColumn2, checkRow) > pivot2 Then
            compareFirstLoop = True

        'Move to Third Column
        ElseIf sortColumn3 <> -1 And ThisArray(sortColumn2, checkRow) = pivot2 Then
            If asc3 = True And ThisArray(sortColumn3, checkRow) < pivot3 Then
                compareFirstLoop = True
            ElseIf asc3 = False And ThisArray(sortColumn3, checkRow) > pivot3 Then
                compareFirstLoop = True

            Else
                compareFirstLoop = False
            End If
        Else
            compareFirstLoop = False
        End If
    Else
        compareFirstLoop = False
    End If

End Function


Private Function compareSecondLoop(ThisArray As Variant, pivot1 As Variant, pivot2 As Variant, pivot3 As Variant, checkRow As Integer, sortColumn1 As Integer, asc1 As Boolean, sortColumn2 As Integer, asc2 As Boolean, sortColumn3 As Integer, asc3 As Boolean)

    If asc1 = True And pivot1 < ThisArray(sortColumn1, checkRow) Then
        compareSecondLoop = True
    ElseIf asc1 = False And pivot1 > ThisArray(sortColumn1, checkRow) Then
        compareSecondLoop = True

    'Move to Second Column
    ElseIf sortColumn2 <> -1 And ThisArray(sortColumn1, checkRow) = pivot1 Then
        If asc2 = True And pivot2 < ThisArray(sortColumn2, checkRow) Then
            compareSecondLoop = True
        ElseIf asc2 = False And pivot2 > ThisArray(sortColumn2, checkRow) Then
            compareSecondLoop = True


        'Move to Third Column
        ElseIf sortColumn3 <> -1 And ThisArray(sortColumn2, checkRow) = pivot2 Then
            If asc3 = True And pivot3 < ThisArray(sortColumn3, checkRow) Then
                compareSecondLoop = True
            ElseIf asc3 = False And pivot3 > ThisArray(sortColumn3, checkRow) Then
                compareSecondLoop = True
            Else
                compareSecondLoop = False
            End If


        Else
            compareSecondLoop = False
        End If
    Else
        compareSecondLoop = False
    End If

End Function