Visual Basic Programming Code Examples

The following code can be used to rapdily sort a 1d array. 'Purpose : Sorts a 1D array. 'Inputs : avValues. The array to sort ' [lLowerBound] The lLowerBound of Array. NOT REQUIRED (USED IN RECURSIVE LOOP) ' [lUpperBound] The lUpperBound of Array. NOT REQUIRED (USED IN RECURSIVE LOOP) ' [bSortDescending ] If True sorts the array in descending order. Defaults to ascending. 'Outputs : avValues is sorted. 'Notes : The optional parameters are not required to be passed in. ' They are only required for the subsequent recursive calls. ' This type of sorting is much faster than "Bubble Sorting", especially ' if your items are order randomly. Sub Array1DSort(ByRef avValues As Variant, Optional lLowerBound As Long, Optional lUpperBound As Long, Optional ByVal bSortDescending As Boolean = False) Dim lTestLower As Long, lTestUpper As Long, vThisItem As Variant, vThisValue As Variant If lLowerBound = 0 Then lLowerBound = LBound(avValues) End If If lUpperBound = 0 Then lUpperBound = UBound(avValues) End If lTestLower = lLowerBound lTestUpper = lUpperBound vThisItem = avValues((lLowerBound + lUpperBound) / 2) If bSortDescending Then Do While (lTestLower <= lTestUpper) Do While (avValues(lTestLower) > vThisItem And lTestLower < lUpperBound) lTestLower = lTestLower + 1 Loop Do While (vThisItem > avValues(lTestUpper) And lTestUpper > lLowerBound) lTestUpper = lTestUpper - 1 Loop If (lTestLower <= lTestUpper) Then vThisValue = avValues(lTestLower) avValues(lTestLower) = avValues(lTestUpper) avValues(lTestUpper) = vThisValue lTestLower = lTestLower + 1 lTestUpper = lTestUpper - 1 End If Loop Else Do While (lTestLower <= lTestUpper) Do While (avValues(lTestLower) < vThisItem And lTestLower < lUpperBound) lTestLower = lTestLower + 1 Loop Do While (vThisItem < avValues(lTestUpper) And lTestUpper > lLowerBound) lTestUpper = lTestUpper - 1 Loop If (lTestLower <= lTestUpper) Then vThisValue = avValues(lTestLower) avValues(lTestLower) = avValues(lTestUpper) avValues(lTestUpper) = vThisValue lTestLower = lTestLower + 1 lTestUpper = lTestUpper - 1 End If Loop End If If (lLowerBound < lTestUpper) Then Array1DSort avValues, lLowerBound, lTestUpper, bSortDescending End If If (lTestLower < lUpperBound) Then Array1DSort avValues, lTestLower, lUpperBound, bSortDescending End If End Sub 'Demonstration routine Sub Test() Dim alValues(1 To 50) As Long, lThisRow As Long 'Create an array containg random numbers Randomize 'Initialize random-number generator For lThisRow = 1 To 50 alValues(lThisRow) = Int((1000 * Rnd) + 1) 'Generate a random number between 1 and 1000 Next 'Sort numbers Array1DSort alValues 'Display results For lThisRow = 1 To 50 Debug.Print alValues(lThisRow) Next End Sub