Sorting a Listbox with multiple columns

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
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
 
Here is the class module to sort any amount of fields of any listbox based on a query. It is a little easier

SortableListBox
Code:
Option Compare Database
Option Explicit



Private mListBox As Access.ListBox
Private mRsOriginalList As DAO.Recordset
Private Sub unSortList()
  On Error GoTo errLable
  Set mListBox.Recordset = mRsOriginalList
   Exit Sub
errLable:
    MsgBox Err.Number & "  " & Err.Description
End Sub
Private Sub Class_Terminate()
    Set mListBox = Nothing
    Set mRsOriginalList = Nothing
End Sub
Public Sub Initialize(TheListbox As Access.ListBox)
  On Error GoTo errLabel
  If Not TheListbox.RowSourceType = "Table/Query" Then
    MsgBox "This class will only work with a ListBox that uses a Table or Query as the Rowsource"
    Exit Sub
  End If
  Set mListBox = TheListbox
  Set mRsOriginalList = mListBox.Recordset.Clone
 Exit Sub
errLabel:
 MsgBox Err.Number & " " & Err.Description
End Sub
Public Sub sortList(SortString As String)
  Dim rs As DAO.Recordset
  Set rs = mListBox.Recordset
  rs.Sort = SortString
  Set mListBox.Recordset = rs.OpenRecordset
  Set rs = mRsOriginalList
  rs.Sort = SortString
  Set mRsOriginalList = rs.OpenRecordset
  rs.Close
  Set rs = Nothing
End Sub

This is use something like

Code:
Public srtLst As New SortableListBox

Private Sub Form_Load()
  srtLst.Initialize Me.lstSearch
End Sub

Public Sub sortTheList(sortField As String)
  srtLst.sortList sortField 
End Sub
 
The bubble sort works well, but have not tried on real large lists. The better solution would be to use a disconnected ADO recordset, but I did not have code for that. You would basically read the columns of the listbox and create a disconnected recordset by defining your fields and populating the recordset. Then you can use the sort property of the recordset. This would be a lot faster and easier than the bubblesort. If I get time I will code.
 
Here is the ADO in memory recordset version. This is fast.
It is a little harder to initialize. For each column you have to pass in the datatype. If numeric use 0 for text use 1
In the form
Code:
Option Compare Database
Option Explicit

'declare a variable of type ListBubbleSort
Public ADO_Sort As ListADOSort
Private Sub Form_Load()
  Set ADO_Sort = New ListADOSort
  'This is the hard part. You need to specify the datatype of each column. Use 0 for any numeric and 1 for text
  ADO_Sort.Initialize_ListADOSort Me.lstSort, 0, 1, 1, 1, 1
End Sub

Private Sub cmdSort1_Click()
  ADO_Sort.Sort 1
End Sub

Private Sub cmdSort2_Click()
  ADO_Sort.Sort 2
End Sub

Private Sub cmdSort3_Click()
  ADO_Sort.Sort 3, True
End Sub

Drop this in a class module named ListADOSort
Code:
Option Compare Database
Option Explicit

'Create an array
Public Enum FieldType
  Numeric = 0
  Text = 1
End Enum
Private mListBox As Access.ListBox
Private mRS_List As ADODB.Recordset

Public Sub Initialize_ListADOSort(TheListbox As Access.ListBox, ParamArray DataTypes() As Variant)
  'For the datatypes use advarChar for text and adDouble for numeric
  Dim MyDataTypes() As Integer
  Dim i As Integer
  ReDim MyDataTypes(UBound(DataTypes))
  Set Me.ListBox = TheListbox
  'This would not make any sense to use on a non value list
  If Me.ListBox.RowSourceType <> "Valuelist" Then convertToValueList
  For i = 0 To UBound(MyDataTypes)
    MyDataTypes(i) = DataTypes(i)
  Next i
  CreateRecordset MyDataTypes
  LoadRecordset
  Me.ListBox.RowSourceType = "Table/Query"
  Set Me.ListBox.Recordset = mRS_List
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
Public Sub CreateRecordset(MyDataTypes() As Integer)
  Dim fld As ADODB.Field
  Dim i As Integer
  Set mRS_List = New ADODB.Recordset
  For i = 0 To Me.ListBox.ColumnCount - 1
     Select Case MyDataTypes(i)
    Case Text
      mRS_List.Fields.Append "Column" & i, adVarChar, 255, adFldMayBeNull
    Case Numeric ' others
      mRS_List.Fields.Append "Column" & i, adDouble, , adFldMayBeNull
    End Select
   Next i
End Sub
Public Sub LoadRecordset()
  Dim i As Integer
  Dim col As Integer
  With mRS_List
    .CursorType = adOpenKeyset
    .CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open
  End With
  For i = 0 To Me.ListBox.ListCount - 1
    mRS_List.AddNew
    For col = 0 To Me.ListBox.ColumnCount - 1
      If mRS_List.Fields(col).Type = adDouble Then
        mRS_List.Fields(col) = CDbl(Me.ListBox.Column(col, i))
      ElseIf mRS_List.Fields(col).Type = adVarChar Then
        mRS_List.Fields(col) = CStr(Me.ListBox.Column(col, i))
      End If
    Next col
    mRS_List.Update
  Next i
End Sub
Public Sub Sort(Column As Integer, Optional Descending = False)
   Dim strSort As String
   If Descending Then
    strSort = "column" & Column & " DESC"
  Else
    strSort = "column" & Column
  End If
  mRS_List.Sort = strSort
  LoadList
End Sub
Public Sub LoadList()
 Set Me.ListBox.Recordset = mRS_List
End Sub
 
Hi Doug
Sorry to have mixed you up with another!
Anyway, welcome to AWF and I hope we will see you here on a regular basis

For info, it was understood from early in this thread that the OP had a value list.
However despite repeated questions, answers weren't given to questions asked.
See e.g. post 14

In your post 14, you said:

"I explained in an earlier post that its also possible to do all the following using table/query row sources:"

However, the OP did not have a table/query row source. He (and I) had a value list row source and in such cases, there is no query definition that can be used to set the sort order.
 
However, the OP did not have a table/query row source. He (and I) had a value list row source and in such cases, there is no query definition that can be used to set the sort order

Take a look at Thread 22 and 24. Both sort any value list of any size with minimal code by the user.
 

Users who are viewing this thread

Back
Top Bottom