title: VBA Bubble Sort Algorithm Slow
body: <p>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 will do? For instance, could using VARIANTs, too many variables, etc. be slowing performance substantially. I know Bubble Sort is not particularly fast, but I didn't think it would be this slow.</p>
  
  <p>Algorithm inputs: 2D array and either one or two columns to sort by, each asc or desc.
  I don't necessarily need lightning fast, but 30 seconds for 5,000 rows is completely unacceptable</p>
  
  <pre><code>Option Explicit
  
  
  Sub sortA()
  
  Dim start_time, end_time
  start_time = Now()
  
  Dim ThisArray() As Variant
      Dim sheet As Worksheet
      Dim a, b As Integer
      Dim rows, cols As Integer
  
      Set sheet = ArraySheet
      rows = 5000
      cols = 3
      ReDim ThisArray(0 To cols - 1, 0 To rows - 1)
  
  
      For a = 1 To rows
          For b = 1 To cols
              ThisArray(b - 1, a - 1) = ArraySheet.Cells(a, b)
          Next b
      Next a
  
      Call BubbleSort(ThisArray, 0, False, 2, True)
  
  end_time = Now()
  MsgBox (DateDiff("s", start_time, end_time))
  
  End Sub
  
  
  
  'Array Must Be: Array(Column,Row)
  Sub BubbleSort(ThisArray As Variant, SortColumn1 As Integer, Asc1 As Boolean, Optional SortColumn2 As Integer = -1, Optional Asc2 As Boolean)
  
      Dim FirstRow As Integer
      Dim LastRow As Integer
      Dim FirstCol As Integer
      Dim LastCol As Integer
      Dim lTemp As Variant
      Dim i, j, k As Integer
      Dim a1, a2, b1, b2 As Variant
      Dim CompareResult As Boolean
  
      FirstRow = LBound(ThisArray, 2)
      LastRow = UBound(ThisArray, 2)
      FirstCol = LBound(ThisArray, 1)
      LastCol = UBound(ThisArray, 1)
  
      For i = FirstRow To LastRow
          For j = i + 1 To LastRow
  
              If SortColumn2 = -1 Then 'If there is only one column to sort by
                  a1 = ThisArray(SortColumn1, i)
                  a2 = ThisArray(SortColumn1, j)
  
                  If Asc1 = True Then
                      CompareResult = compareOne(a1, a2)
                  Else
                      CompareResult = compareOne(a2, a1)
                  End If
  
              Else 'If there are two columns to sort by
                  a1 = ThisArray(SortColumn1, i)
                  a2 = ThisArray(SortColumn1, j)
                  b1 = ThisArray(SortColumn2, i)
                  b2 = ThisArray(SortColumn2, j)
  
                  If Asc1 = True Then
                      If Asc2 = True Then
                          CompareResult = compareTwo(a1, a2, b1, b2)
                      Else
                          CompareResult = compareTwo(a1, a2, b2, b1)
                      End If
                  Else
                      If Asc2 = True Then
                          CompareResult = compareTwo(a2, a1, b1, b2)
                      Else
                          CompareResult = compareTwo(a2, a1, b2, b1)
                      End If
                  End If
              End If
  
              If CompareResult = True Then ' If compare result returns true, Flip rows
                   For k = FirstCol To LastCol
                       lTemp = ThisArray(k, j)
                       ThisArray(k, j) = ThisArray(k, i)
                       ThisArray(k, i) = lTemp
                   Next k
              End If
          Next j
      Next i
  
  End Sub
  
  Function compareOne(FirstCompare1 As Variant, FirstCompare2 As Variant) As Boolean
  
      If FirstCompare1 &gt; FirstCompare2 Then
          compareOne = True
      Else
          compareOne = False
      End If
  
  End Function
  
  
  Function compareTwo(FirstCompare1 As Variant, FirstCompare2 As Variant, SecondCompare1 As Variant, SecondCompare2 As Variant) As Boolean
  
      If FirstCompare1 &gt; FirstCompare2 Then
          compareTwo = True
      ElseIf FirstCompare1 = FirstCompare2 And SecondCompare1 &gt; SecondCompare2 Then
          compareTwo = True
      Else
          compareTwo = False
      End If
  
  End Function
  </code></pre>
  
  <p>Thanks a ton for any help or advice!!</p>
  
  <p>Edit: I decided to used QuickSort instead. See post below for the code if interested.</p>