snippetMinor
Robust Bubble Sort in VBA
Viewed 0 times
sortbubblerobustvba
Problem
I'm creating a robust bubble sort for VBA when sorting stored arrays in VBA. Mostly this would be used when an array is stored in a single cell with a delimiter. Otherwise, one could just sort on the sheet during intake.
I'm trying to make this as robust as I can so it can be used as a tool rather than just continually rewriting it for each task when I need it. It can sort ascending or descending, the intention being that one may be able to use it to get minimums, maximums and medians.
I'd like to make it able to sort alphabetically, but right now it only sorts numbers. I mention this because I'd like to refactor the procedure that turns the variant array (hence the area with extra white space) into the double array, but I can't figure out an optimal way to do that without sending copies of arrays around, so it's just sitting in the
Also, if the bubble sort method isn't the most robust sort algorithm to be using, I'd love to know that so I can try again.
Example input would be something like this
```
Option Explicit
Public Sub TestBubbleSorting()
Const DELIMITER As String = ","
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet
Dim numberOfArrays As Long
numberOfArrays = targetSheet.Cells(1, 1)
Dim rawArray As Variant
Dim arrayToSort() As Double
Dim targetRow As Long
Dim targetElement As Long
Dim numberOfElements As Long
Dim inputValue As String
Dim outputValue As String
For targetRow = 2 To numberOfArrays + 1
inputValue = targetSheet.Cells(targetRow, 1)
If Replace(inputValue, DELIMITER, vbNullString) = vbNullString Then GoTo NextIteration
rawArray = GetArrayFromCell(inputValue, DELIMITER)
numberOfElements = UBound(rawArray) + 1
ReDim arrayToSort(1 To numberOfElements)
For targetElement = 0 To numberOfElements - 1
I'm trying to make this as robust as I can so it can be used as a tool rather than just continually rewriting it for each task when I need it. It can sort ascending or descending, the intention being that one may be able to use it to get minimums, maximums and medians.
I'd like to make it able to sort alphabetically, but right now it only sorts numbers. I mention this because I'd like to refactor the procedure that turns the variant array (hence the area with extra white space) into the double array, but I can't figure out an optimal way to do that without sending copies of arrays around, so it's just sitting in the
TestBubbleSorting procedure right now. Any suggestions on that refactoring would be awesome. Also, if the bubble sort method isn't the most robust sort algorithm to be using, I'd love to know that so I can try again.
Example input would be something like this
3
7,3,5
15,20,40
300,550,137```
Option Explicit
Public Sub TestBubbleSorting()
Const DELIMITER As String = ","
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet
Dim numberOfArrays As Long
numberOfArrays = targetSheet.Cells(1, 1)
Dim rawArray As Variant
Dim arrayToSort() As Double
Dim targetRow As Long
Dim targetElement As Long
Dim numberOfElements As Long
Dim inputValue As String
Dim outputValue As String
For targetRow = 2 To numberOfArrays + 1
inputValue = targetSheet.Cells(targetRow, 1)
If Replace(inputValue, DELIMITER, vbNullString) = vbNullString Then GoTo NextIteration
rawArray = GetArrayFromCell(inputValue, DELIMITER)
numberOfElements = UBound(rawArray) + 1
ReDim arrayToSort(1 To numberOfElements)
For targetElement = 0 To numberOfElements - 1
Solution
In large I think the sort function is right out of the book of bubblesort.
IMO your naming is a little overdone. The long names are for an inexperienced eye hard to read.
The ascending and descending sort loops are essentially the same except for the direction of the comparation, so no need for backward loop or special temporary variables etc.
The swap mechanism calls for a swap function.
All in all find below a revised version of the sort function.
All that said, bubble sort is not the most efficient algorithm, so if you have large data sets to sort I will suggest other more powerfull algorithms like quicksort, mergesort, heapsort or combsort where quicksort and combsort maybe are the easiest to implement (they are all well documented on Wikipedia).
IMO your naming is a little overdone. The long names are for an inexperienced eye hard to read.
The ascending and descending sort loops are essentially the same except for the direction of the comparation, so no need for backward loop or special temporary variables etc.
The swap mechanism calls for a swap function.
All in all find below a revised version of the sort function.
Private Sub Swap(vector() As Double, i As Long, j As Long)
Dim tmp As Double
tmp = vector(i)
vector(i) = vector(j)
vector(j) = tmp
End Sub
Private Sub BubbleSortNumbers(vector() As Double, Optional sortAscending As Boolean = True)
Dim index As Long
Dim isChanged As Boolean
Dim first As Long
Dim last As Long
first = 1
last = UBound(vector) - 1
If sortAscending Then
Do
isChanged = False
For index = first To last
If vector(index) > vector(index + 1) Then
isChanged = True
Swap vector, index, index + 1
End If
Next index
last = last - 1 ' The not yet positioned largest value "rabbits" down to its final position for every loop, so there is no need for checking it again.
Loop While isChanged
Else
Do
isChanged = False
For index = first To last
If vector(index) < vector(index + 1) Then
isChanged = True
Swap vector, index, index + 1
End If
Next index
last = last - 1
Loop While isChanged
End If
End SubAll that said, bubble sort is not the most efficient algorithm, so if you have large data sets to sort I will suggest other more powerfull algorithms like quicksort, mergesort, heapsort or combsort where quicksort and combsort maybe are the easiest to implement (they are all well documented on Wikipedia).
Code Snippets
Private Sub Swap(vector() As Double, i As Long, j As Long)
Dim tmp As Double
tmp = vector(i)
vector(i) = vector(j)
vector(j) = tmp
End Sub
Private Sub BubbleSortNumbers(vector() As Double, Optional sortAscending As Boolean = True)
Dim index As Long
Dim isChanged As Boolean
Dim first As Long
Dim last As Long
first = 1
last = UBound(vector) - 1
If sortAscending Then
Do
isChanged = False
For index = first To last
If vector(index) > vector(index + 1) Then
isChanged = True
Swap vector, index, index + 1
End If
Next index
last = last - 1 ' The not yet positioned largest value "rabbits" down to its final position for every loop, so there is no need for checking it again.
Loop While isChanged
Else
Do
isChanged = False
For index = first To last
If vector(index) < vector(index + 1) Then
isChanged = True
Swap vector, index, index + 1
End If
Next index
last = last - 1
Loop While isChanged
End If
End SubContext
StackExchange Code Review Q#145601, answer score: 3
Revisions (0)
No revisions yet.