# Sort_TwoDimensionBubble

Sorts a 2-dimensional array

Original Author: Gordon Fuller

### Inputs

TempArray Variant
iElement Integer
iDimension Integer
bAscOrder Boolean

### Assumptions

Best used for smaller arrays, since the bubblesort algorithm is not suited to very large arrays

### Returns

Boolean if the sort was successful

### Code

`'?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»' Name:     Sort_TwoDimensionBubble' VB Version:  6.00' Called by:  Procedures     Events'        ----------     ------'' Author:    Gordon McI. Fuller' Copyright:  ?®2000 Force 10 Automation' Created:   Friday, March 17, 2000' Modified:   [Friday, March 17, 2000]' Purpose:' Inputs:  Param    Name          Type    Meaning'      -----    ----          ----    -------'            TempArray        Variant'      Optional  iElement        Integer'      Optional  iDimension       Integer = 1'      Optional  bAscOrder        Boolean = True' Returns:   True/False for success of the sort' Global Used:' Module used:'------------------------------------------------------------' Notes:    This is a bubble sort'        For large arrays it may not be the most efficient'          option, but I haven't found anything in a'          multi-dimension sort using another algorithm.''  Sample array  array(0,0) = Apples'          array(0,1) = 5'          array(0,2) = Tree'          array(1,0) = Grapes'          ...'      Apples     5    Tree'      Grapes     2    Vine'      Pears      3    Tree'  The iDimension is 1 because it am sorting by the "rows" of the'    first dimension rather than the "columns" of the 2nd'  Since we would want to sort by the numeric value,'    the iElement variable is 1'  bAscOrder indicates whether the sort order is ascending or descending''  If the array were structured as'         array(0,0) = "Apples"'         array(1,0) = 5'         array(2,0) = Tree'         ...'      Apples     Grapes   Tree'      5        2      3'      Tree      Vine    Tree'  iDimension will be 2 since we are sorting on the "columns"'  iElement will still be 1 since we are sorting by that numeric value'?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»?»Function Sort_TwoDimensionBubble(TempArray As Variant, _            Optional iElement As Integer = 1, _            Optional iDimension As Integer = 1, _            Optional bAscOrder As Boolean = True) As Boolean  Dim arrTemp As Variant  Dim i%, j%  Dim NoExchanges As Integer  On Error GoTo Error_BubbleSort  ' Loop until no more "exchanges" are made.  If iDimension% = 1 Then    ReDim arrTemp(1, UBound(TempArray, 2))  Else    ReDim arrTemp(UBound(TempArray, 1), 1)  End If    Do    NoExchanges = True    ' Loop through each element in the array.    If iDimension% = 1 Then      For i% = LBound(TempArray, iDimension%) To UBound(TempArray, iDimension%) - 1          ' If the element is greater than the element        ' following it, exchange the two elements.        If (bAscOrder And (TempArray(i%, iElement%) > TempArray(i% + 1, iElement%))) _            Or (Not bAscOrder And (TempArray(i%, iElement%) < TempArray(i% + 1, iElement%))) _          Then            NoExchanges = False            For j% = LBound(TempArray, 2) To UBound(TempArray, 2)              arrTemp(1, j%) = TempArray(i%, j%)            Next j%            For j% = LBound(TempArray, 2) To UBound(TempArray, 2)              TempArray(i%, j%) = TempArray(i% + 1, j%)            Next j%            For j% = LBound(TempArray, 2) To UBound(TempArray, 2)              TempArray(i% + 1, j%) = arrTemp(1, j%)            Next j%        End If      Next i%    Else      For i% = LBound(TempArray, iDimension%) To UBound(TempArray, iDimension%) - 1          ' If the element is greater than the element        ' following it, exchange the two elements.        If (bAscOrder And (TempArray(iElement%, i%) > TempArray(iElement%, i% + 1))) _            Or (Not bAscOrder And (TempArray(iElement%, i%) < TempArray(iElement%, i% + 1))) _          Then            NoExchanges = False            For j% = LBound(TempArray, 1) To UBound(TempArray, 1)              arrTemp(j%, 1) = TempArray(j%, i%)            Next j%            For j% = LBound(TempArray, 1) To UBound(TempArray, 1)              TempArray(j%, i%) = TempArray(j%, i% + 1)            Next j%            For j% = LBound(TempArray, 1) To UBound(TempArray, 1)              TempArray(j%, i% + 1) = arrTemp(j%, 1)            Next j%        End If      Next i%    End If  Loop While Not (NoExchanges)  Sort_TwoDimensionBubble = True  On Error GoTo 0  Exit FunctionError_BubbleSort:  On Error GoTo 0  Sort_TwoDimensionBubble = FalseEnd Function`

Posted: 2002-06-01
By: ArchiveBot
Viewed: 92 times

Categories

Visual Basic 6

Attachments

No attachments for this post