MajP
You've got your good things, and you've got mine.
- Local time
- Today, 18:31
- Joined
- May 21, 2018
- Messages
- 8,929
The following code sorts any amount of columns and numeric or string datatypes.
Takes the user about 4 lines of code to use.
In form module
Drop this into a class module named exactly ListBubbleSort
Takes the user about 4 lines of code to use.
In form module
Code:
'declare a variable of type ListBubbleSort
Public lstBubbleSort As ListBubbleSort
'Initialize in load
Private Sub Form_Load()
Set lstBubbleSort = New ListBubbleSort
lstBubbleSort.Initialize_BubbleSort Me.lstSort
End Sub
'Tell it what field and if it is numeric or text
Private Sub cmdBubble2_Click()
lstBubbleSort.BubbleSortList 1, sttext
End Sub
Private Sub cmdBubbleSort1_Click()
lstBubbleSort.BubbleSortList 0, stNumeric
End Sub
Drop this into a class module named exactly ListBubbleSort
Code:
Option Compare Database
Option Explicit
'Create an array
Private mListBox As Access.ListBox
Private mlistArray() As String
'Determine Sort Type
Public Enum SortType
stNumeric = 0 ' Includes date
sttext = 1
End Enum
Public Sub Initialize_BubbleSort(TheListbox As Access.ListBox)
Set Me.ListBox = TheListbox
If Me.ListBox.RowSourceType <> "Valuelist" Then convertToValueList
FillArray
End Sub
Public Property Get ListBox() As Access.ListBox
Set ListBox = mListBox
End Property
Public Property Set ListBox(TheListbox As Access.ListBox)
Set mListBox = TheListbox
End Property
'Only needed to turn query into value list
Private Sub convertToValueList()
Dim rs As DAO.Recordset
Dim strSql As String
Dim fldField As DAO.Field
Dim strLstValue As String
Dim intColCount As Integer
Dim intColCounter As Integer
Dim intRowCounter As Integer
Dim TheListbox As Access.ListBox
Set TheListbox = Me.ListBox
If TheListbox.RowSourceType = "Table/Query" Then
intColCount = TheListbox.ColumnCount
strSql = TheListbox.RowSource
TheListbox.RowSource = ""
Set rs = CurrentDb.OpenRecordset(strSql)
TheListbox.RowSourceType = "Value List"
Do While Not rs.EOF
For intColCounter = 0 To intColCount - 1
strLstValue = strLstValue & "'" & CStr(Nz(rs.Fields(intColCounter), " ")) & "';"
Next intColCounter
intRowCounter = intRowCounter + 1
rs.MoveNext
strLstValue = Left(strLstValue, Len(strLstValue) - 1)
TheListbox.addItem (strLstValue)
strLstValue = ""
Loop
End If
End Sub
'Fill an array
Private Sub FillArray()
Dim i As Integer
Dim n As Integer
Dim Col As Integer
Dim Val As String
n = Me.ListBox.ListCount
ReDim mlistArray(n - 1)
For i = 0 To Me.ListBox.ListCount - 1
For Col = 0 To Me.ListBox.ColumnCount - 1
Val = Val & Me.ListBox.Column(Col, i) & ";"
Next Col
mlistArray(i) = Val
Val = ""
Next i
End Sub
'Bubble sort based on column and sort type
Public Sub BubbleSortList(ColumnNumber As Integer, Optional SortType As SortType = sttext)
Dim i As Integer
Dim J As Integer
Dim n As Integer
Dim ValJ As Variant
Dim ValJPlus1 As Variant
n = UBound(mlistArray)
For i = 0 To n
For J = 0 To (n - i) - 1
Select Case SortType
Case stNumeric
ValJ = CDbl(Split(mlistArray(J), ";")(ColumnNumber))
ValJPlus1 = CDbl(Split(mlistArray(J + 1), ";")(ColumnNumber))
Case sttext
ValJ = CStr(Split(mlistArray(J), ";")(ColumnNumber))
ValJPlus1 = CStr(Split(mlistArray(J + 1), ";")(ColumnNumber))
End Select
If ValJ > ValJPlus1 Then SwapListItem J, J + 1
Next J
Next i
LoadListBox
End Sub
Public Sub SwapListItem(ByVal J As Integer, ByVal Jplus1 As Integer)
Dim ValTemp As String
ValTemp = mlistArray(J)
mlistArray(J) = mlistArray(Jplus1)
mlistArray(Jplus1) = ValTemp
End Sub
Public Sub LoadListBox()
Me.ListBox.RowSource = ""
Dim i As Integer
For i = 0 To UBound(mlistArray)
Me.ListBox.addItem mlistArray(i)
Next i
End Sub