by Graeme Matthew (1 Submission)
Category: Miscellaneous
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Thu 13th December 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Sorts a single or multidimensional array by 1 or 2 columns and keeps the state of the data.
VBcoders
'Name: gbBubbleSortArray
'Purpose: sorts a single dimension or multidimensional array by either one column or two columns
'Inputs: An array passed by reference
' The first column to sort on (default 0)
' The second column to sort on (default NULL ie nothing)
' The sort order of thew two columns, default Descending
'Process: Sorts primary column (column 1) by calling the same function
' Sorts secondary column
'Outputs: Nothing (boolean success or failure return to be implemented)
'Warning: The array structure is assumed to be one where the first dimension is the
' column definitions and the second dimension are the rows
' It sorts laterally not vertically !!!!!
' ie 0 1 2 3 4
' 0 70 71 72 73 74
' 1 809 809 88 90 755
' In the example above: Dimension 1 consists of 2 rows, these are the columns
' 0 is the contact id
' 1 is the company id
' The columns moving from left to right are the record values
' The reason for this is that most of my arrays are populated from the GetRows() method
' and it places it in this structure.
' Visual Basic array handling mechanisms, only the last dimension can be expanded
Public Function gbBubbleSortArray(ByRef rvntArray As Variant, _
Optional ByVal vbTwoDimensions As Boolean = False, _
Optional ByVal vvntColumnToSortOn As Integer = 0, _
Optional ByVal vvnt2ndColumnSortOn As Variant = Null, _
Optional ByVal vbDescending As Boolean = True) As Boolean
Dim bSorted As Boolean: Dim bSwap As Boolean
Dim lCounter As Long: Dim lItems As Long: Dim lStart As Long: Dim lFields As Long: Dim lFieldCounter As Long
Dim vntTemp, vntCol1Val, vntCol2Val As Variant, vntCol1PrevVal, vntCol2PrevVal
'Determine Dimensions
If vbTwoDimensions = True Then
lStart = LBound(rvntArray, 2): lItems = UBound(rvntArray, 2): lFields = UBound(rvntArray, 1)
Else
lStart = LBound(rvntArray): lItems = UBound(rvntArray)
End If
'If there is a second column to sort on then sort on primary column first
If Not IsNull(vvnt2ndColumnSortOn) Then gbBubbleSortArray rvntArray, True, vvntColumnToSortOn, , vbDescending
Do While bSorted = False
bSorted = True
For lCounter = lItems - 1 To lStart Step -1
bSwap = False
'SINGLE DIMENSION
If vbTwoDimensions = False Then
'DESCENDING SORT ON SINGLE DIMENSION
If vbDescending = False Then
If rvntArray(lCounter + 1) < rvntArray(lCounter) Then
bSorted = False
bSwap = True
End If
'ASCENDING SORT ON SINGLE DIMENSION
Else
If rvntArray(lCounter + 1) > rvntArray(lCounter) Then
bSorted = False
bSwap = True
End If
End If
'Check if we need to swap values
If bSwap = True Then
bSwap = False
vntTemp = rvntArray(lCounter)
rvntArray(lCounter) = rvntArray(lCounter + 1)
rvntArray(lCounter + 1) = vntTemp
End If
'****** 2 DIMENSION DATA SET
Else
'DESCENDING SORT ON 2 DIMENSIONS
If vbDescending = False Then
'TWO COLUMN SORT
If Not IsNull(vvnt2ndColumnSortOn) = True Then
If rvntArray(vvntColumnToSortOn, lCounter + 1) = rvntArray(vvntColumnToSortOn, lCounter) And rvntArray(vvnt2ndColumnSortOn, lCounter + 1) < rvntArray(vvnt2ndColumnSortOn, lCounter) Then
bSorted = False
bSwap = True
End If
'1 COLUMN SORT
Else
If rvntArray(vvntColumnToSortOn, lCounter + 1) < rvntArray(vvntColumnToSortOn, lCounter) Then
bSorted = False
bSwap = True
End If
End If
'ASCENDING SORT
Else
If Not IsNull(vvnt2ndColumnSortOn) = True Then
If rvntArray(vvntColumnToSortOn, lCounter + 1) = rvntArray(vvntColumnToSortOn, lCounter) And rvntArray(vvnt2ndColumnSortOn, lCounter + 1) > rvntArray(vvnt2ndColumnSortOn, lCounter) Then
bSorted = False
bSwap = True
End If
Else
If rvntArray(vvntColumnToSortOn, lCounter + 1) > rvntArray(vvntColumnToSortOn, lCounter) Then
bSorted = False
bSwap = True
End If
End If
End If
'Check if we need to swap values
If bSwap = True Then
For lFieldCounter = 0 To lFields
bSwap = False
vntTemp = rvntArray(lFieldCounter, lCounter)
rvntArray(lFieldCounter, lCounter) = rvntArray(lFieldCounter, lCounter + 1)
rvntArray(lFieldCounter, lCounter + 1) = vntTemp
Next lFieldCounter
End If
'END OF DIMENSION CHECK
End If
Next lCounter
Loop
End Function
No comments have been posted about Sorts a single or multidimensional array by 1 or 2 columns and keeps the state of the data.. Why not be the first to post a comment about Sorts a single or multidimensional array by 1 or 2 columns and keeps the state of the data..