I found some code on the net but I haven't tried it out yet.
Bubble Sort Code # 1
Public Sub BubbleSortFlexGrid(FGrid As MSHFlexGrid, _
Col As Long, Optional StartRow As Long = 0, _
Optional Desc As Boolean = False)
Dim SortType As Integer
Dim i As Long
Dim k As Long
Dim Val1
Dim Val2
Dim SecVal1
Dim SecVal2
Dim bSorted As Boolean
Screen.MousePointer = vbHourglass
DoEvents
DoEvents
With FGrid
.Visible = False
DoEvents
DoEvents
.Col = Col
.Row = StartRow
If IsNumeric(.Text) Then
SortType = 1
Else
SortType = 0
End If
Select Case SortType
Case 1
bSorted = False
Do While Not bSorted
bSorted = True
For i = StartRow To .Rows - 2
If Desc Then
.Col = Col
.Row = (i)
Val1 = .Text
.Row = (i + 1)
Val2 = .Text
If csng(Val1) < csng(Val2) Then
DoEvents
bSorted = False
For k = 0 To .Cols - 1
.Col = k
.Row = (i + 1)
SecVal1 = .Text
.Row = (i)
SecVal2 = .Text
.Text = SecVal1
.Row = (i + 1)
.Text = SecVal2
Next k
End If
Else
.Col = Col
.Row = (i + 1)
Val1 = .Text
.Row = (i)
Val2 = .Text
If csng(Val1) < csng(Val2) Then
DoEvents
bSorted = False
For k = 0 To .Cols - 1
.Col = k
.Row = (i)
SecVal1 = .Text
.Row = (i + 1)
SecVal2 = .Text
.Text = SecVal1
.Row = (i)
.Text = SecVal2
Next k
End If
End If
Next i
Loop
Case 0
bSorted = False
Do While Not bSorted
bSorted = True
For i = StartRow To .Rows - 2
If Desc Then
.Col = Col
.Row = (i)
Val1 = .Text
.Row = (i + 1)
Val2 = .Text
If Val1 > Val2 Then
DoEvents
bSorted = False
For k = 0 To .Cols - 1
.Col = k
.Row = (i)
SecVal1 = .Text
.Row = (i + 1)
SecVal2 = .Text
.Text = SecVal1
.Row = (i)
.Text = SecVal2
Next k
End If
Else
.Col = Col
.Row = (i + 1)
Val1 = .Text
.Row = (i)
Val2 = .Text
If Val1 < Val2 Then
DoEvents
bSorted = False
For k = 0 To .Cols - 1
.Col = k
.Row = (i + 1)
SecVal1 = .Text
.Row = (i)
SecVal2 = .Text
.Text = SecVal1
.Row = (i + 1)
.Text = SecVal2
Next k
End If
End If
Next i
Loop
End Select
DoEvents
DoEvents
.Visible = True
End With
DoEvents
DoEvents
DoEvents
Screen.MousePointer = vbDefault
End Sub
BUBBLE SORT CODE # 2
Public Function BubbleSortArray(ByVal NumericArray As Variant) _
As Variant
'RETURNS Array, or vbEmpty if there's an error
'e.g., passed array contains elements that
'can't be compared to each other, such as
'objects
'will work when elements are all numbers or single characters
'of the same case.
Dim vAns As Variant
Dim vTemp As Variant
Dim bSorted As Boolean
Dim lCtr As Long
Dim lCount As Long
Dim lStart As Long
Dim lPass as long
vAns = NumericArray
If Not IsArray(vAns) Then
BubbleSortArray = vbEmpty
Exit Function
End If
On Error GoTo ErrorHandler
lStart = LBound(vAns)
lCount = UBound(vAns)
lPass=0
bSorted = False
Do While Not bSorted
bSorted = True
For lCtr = lCount - 1 To lStart + lPass Step -1
If vAns(lCtr + 1) < vAns(lCtr) Then
DoEvents
bSorted = False
vTemp = vAns(lCtr)
vAns(lCtr) = vAns(lCtr + 1)
vAns(lCtr + 1) = vTemp
End If
Next lCtr
lPass = lPass + 1
Loop
BubbleSortArray = vAns
Exit Function
ErrorHandler:
BubbleSortArray = vbEmpty
Exit Function
End Function
