Data Sorting in VB6

bubblesort

 ' min and max are the minimum and maximum indexes
 ' of the items that might still be out of order.
 Sub BubbleSort (List() As Long, ByVal min As Integer, _
     ByVal max As Integer)
 Dim last_swap As Integer
 Dim i As Integer
 Dim j As Integer
 Dim tmp As Long
 
     ' Repeat until we are done.
     Do While min < max
         ' Bubble up.
         last_swap = min - 1
         ' For i = min + 1 To max
         i = min + 1
         Do While i <= max
             ' Find a bubble.
             If List(i - 1) > List(i) Then
                 ' See where to drop the bubble.
                 tmp = List(i - 1)
                 j = i
                 Do
                     List(j - 1) = List(j)
                     j = j + 1
                     If j > max Then Exit Do
                 Loop While List(j) < tmp
                 List(j - 1) = tmp
                 last_swap = j - 1
                 i = j + 1
             Else
                 i = i + 1
             End If
         Loop
         ' Update max.
         max = last_swap - 1
 
         ' Bubble down.
         last_swap = max + 1
         ' For i = max - 1 To min Step -1
         i = max - 1
         Do While i >= min
             ' Find a bubble.
             If List(i + 1) < List(i) Then
                 ' See where to drop the bubble.
                 tmp = List(i + 1)
                 j = i
                 Do
                     List(j + 1) = List(j)
                     j = j - 1
                     If j < min Then Exit Do
                 Loop While List(j) > tmp
                 List(j + 1) = tmp
                 last_swap = j + 1
                 i = j - 1
             Else
                 i = i - 1
             End If
         Loop
         ' Update min.
         min = last_swap + 1
     Loop
 End Sub

quicksort (and remove duplicates)

This program sorts a list using a standard quicksort algorithm. See the code for how the algorithm works.

Then if you have the Remove Dupes option selected, the program removes duplicates. It scans through the sorted array, comparing each item to the one before it. If the item is different, it copies the item into a new array.

 Public Function RemoveDups(strings() As String) As String()
 Dim old_i As Integer
 Dim last_i As Integer
 Dim result() As String
 
     ' Make the result array.
     ReDim result(1 To UBound(strings))
 
     ' Copy the first item into the result array.
     result(1) = strings(1)
 
     ' Copy the other items
     last_i = 1
     For old_i = 2 To UBound(strings)
         If result(last_i) <> strings(old_i) Then
             last_i = last_i + 1
             result(last_i) = strings(old_i)
         End If
     Next old_i
 
     ' Remove unused entries from the result array.
     ReDim Preserve result(1 To last_i)
 
     ' Return the result array.
     RemoveDups = result
 End Function

Quicksort is a fine general purpose sorting algorithm. For different kinds of data, however, it may not be the fastest or the best. For example, it has trouble sorting lists that contain many duplicate values and the algorithm countingsort is much faster at sorting numeric data.

• Keep in mind that you cannot use countingsort to sort strings.

countingsort

Countingsort does not use comparisons. The items to sort must be integers, and this sort works best with a limited or defined range. A range across 1000 will work well, a range across 100,000 will not.

 Sub Countingsort (List() As Long, sorted_list() As Long, _
     min As Integer, max As Integer, min_value As Long, _
     max_value As Long)
 Dim counts() As Integer
 Dim i As Integer
 Dim this_count As Integer
 Dim next_offset As Integer
 
     ' Create the Counts array.
     ReDim counts(min_value To max_value)
 
     ' Count the items.
     For i = min To max
         counts(List(i)) = counts(List(i)) + 1
     Next i
 
     ' Convert the counts into offsets.
     next_offset = min
     For i = min_value To max_value
         this_count = counts(i)
         counts(i) = next_offset
         next_offset = next_offset + this_count
     Next i
 
     ' Place the items in the sorted array.
     For i = min To max
         sorted_list(counts(List(i))) = List(i)
         counts(List(i)) = counts(List(i)) + 1
     Next i
 End Sub

selectionsort

 Sub Selectionsort (List() As Long, min As Integer, _
     max As Integer)
 Dim i As Integer
 Dim j As Integer
 Dim best_value As Long
 Dim best_j As Integer
 
     For i = min To max - 1
         best_value = List(i)
         best_j = i
         For j = i + 1 To max
             If List(j) < best_value Then
                 best_value = List(j)
                 best_j = j
             End If
         Next j
         List(best_j) = List(i)
         List(i) = best_value
     Next i
 End Sub