<![CDATA[
'**************************************
' Name: Sort_TwoDimensionBubble
' Description:Sorts a 2-dimensional arra
' y
' By: Gordon Fuller
'
'
' Inputs:TempArrayVariant
iElementInteger
iDimension Integer
bAscOrderBoolean
'
' Returns:Boolean if the sort was succes
' sful
'
'Assumes:Best used for smaller arrays, s
' ince the bubblesort algorithm is not sui
' ted to very large arrays
'
'Side Effects:None
'
'Warranty:
'Code provided by Planet Source Code(tm)
' (http://www.Planet-Source-Code.com) 'as
' is', without warranties as to performanc
' e, fitness, merchantability,and any othe
' r warranty (whether expressed or implied
' ).
'Terms of Agreement:
'By using this source code, you agree to
' the following terms...
' 1) You may use this source code in per
' sonal projects and may compile it into a
' n .exe/.dll/.ocx and distribute it in bi
' nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
' e code (for example to a web site) witho
' ut written permission from the original
' author.Failure to do so is a violation o
' f copyright laws.
' 3) You may link to this code from anot
' her website, provided it is not wrapped
' in a frame.
' 4) The author of this code may have re
' tained certain additional copyright righ
' ts.If so, this is indicated in the autho
' r's description.
'**************************************
'ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
' 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:ParamNameTypeMeaning
'--------------------
'TempArrayVariant
'OptionaliElementInteger
'OptionaliDimension Integer = 1
'OptionalbAscOrderBoolean = 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 algo
' rithm.
'
'Sample arrayarray(0,0) = Apples
'array(0,1) = 5
'array(0,2) = Tree
'array(1,0) = Grapes
'...
'Apples 5Tree
'Grapes 2Vine
'Pears3Tree
'The iDimension is 1 because it am sorti
' ng by the "rows" of the
'first dimension rather than the "column
' s" of the 2nd
'Since we would want to sort by the nume
' ric value,
'the iElement variable is 1
'bAscOrder indicates whether the sort or
' der 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
'523
'TreeVineTree
'iDimension will be 2 since we are sorti
' ng on the "columns"
'iElement will still be 1 since we are s
' orting 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 mad
' e.
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 ele
' ment
' following it, exchange the two element
' s.
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 ele
' ment
' following it, exchange the two element
' s.
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 Function
Error_BubbleSort:
On Error GoTo 0
Sort_TwoDimensionBubble = False
End Function
]]>