Sorting a Listbox with multiple columns (1 Viewer)

[rede96]

I'm trying to sort a multiple column listbox. The listbox is a value list.

I've found some code (listed below) which may work but it was written for Excel and I get compile errors when trying to use the code as I don't think Access recognises MSForms.listbox & the .list property

Can anyone help?

Sub SortListBox(oLb As MSForms.ListBox, sCol As Integer, sType As Integer, sDir As Integer)
Dim vaItems As Variant
Dim i As Long, j As Long
Dim c As Integer
Dim vTemp As Variant

'Put the items in a variant array
vaItems = oLb.List

'Sort the Array Alphabetically(1)
If sType = 1 Then
For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
For j = i + 1 To UBound(vaItems, 1)
'Sort Ascending (1)
If sDir = 1 Then
If vaItems(i, sCol) > vaItems(j, sCol) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If

'Sort Descending (2)
ElseIf sDir = 2 Then
If vaItems(i, sCol) < vaItems(j, sCol) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If
End If

Next j
Next i
'Sort the Array Numerically(2)
'(Substitute CInt with another conversion type (CLng, CDec, etc.) depending on type of numbers in the column)
ElseIf sType = 2 Then
For i = LBound(vaItems, 1) To UBound(vaItems, 1) - 1
For j = i + 1 To UBound(vaItems, 1)
'Sort Ascending (1)
If sDir = 1 Then
If CInt(vaItems(i, sCol)) > CInt(vaItems(j, sCol)) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If

'Sort Descending (2)
ElseIf sDir = 2 Then
If CInt(vaItems(i, sCol)) < CInt(vaItems(j, sCol)) Then
For c = 0 To oLb.ColumnCount - 1 'Allows sorting of multi-column ListBoxes
vTemp = vaItems(i, c)
vaItems(i, c) = vaItems(j, c)
vaItems(j, c) = vTemp
Next c
End If
End If

Next j
Next i
End If

'Set the list to the array
oLb.List = vaItems
End Sub

 

[isladogs]

Rather than go through your code line by line, there's a much easier approach.
Using a standard listbox, just use option buttons to alter the sql for the listbox row source
E.g.sort by name A-Z, sort by DOB etc.
The same method can be used to filter the listbox e.g males only, those over 65 etc

 

[rede96]

Rather than go through your code line by line, there's a much easier approach.
Using a standard listbox, just use option buttons to alter the sql for the listbox row source
E.g.sort by name A-Z, sort by DOB etc.
The same method can be used to filter the listbox e.g males only, those over 65 etc

Thanks for the reply Unfortunately the listbox row source is a value list and not a query. The list box is populated from a query via the recordedset method but as I need to move rows from one list box to another, this can only be done using a value list. So normal sorting isn't available.

EDIT: Also as the rows can be moved up and down and new rows added, I can't just sort the recordset when I populate the listbox, there are various times it will need to be sorted after the import.

 

[rede96]

Rather than go through your code line by line, there's a much easier approach.

There is actually only two issues that access doesn't recognise.

oLb As MSForms.ListBox

in the sub declaration and

vaItems = oLb.List

 

[isladogs]

Thanks for the reply Unfortunately the listbox row source is a value list and not a query. The list box is populated from a query via the recordedset method but as I need to move rows from one list box to another, this can only be done using a value list. So normal sorting isn't available.

EDIT: Also as the rows can be moved up and down and new rows added, I can't just sort the recordset when I populate the listbox, there are various times it will need to be sorted after the import.

Sorry but I disagree with both of the points above. Here are 2 examples:

The screenshots below are the same listbox based on a query. It can be sorted or filtered using command buttons

The next screenshot is also based on a query and shows a listbox where the items can be moved up or down or added or deleted

As for your 2 errors, I don't use ActiveX listboxes so can't explain what you need to do to change the code

HTH

 

[rede96]

Sorry but I disagree with both of the points above. Here are 2 examples:

The screenshots below are the same listbox based on a query. It can be sorted or filtered using command buttons

The next screenshot is also based on a query and shows a listbox where the items can be moved up or down or added or deleted

As for your 2 errors, I don't use ActiveX listboxes so can't explain what you need to do to change the code

HTH

Ok, then maybe its just my understanding. I use the .RemoveItem and .Additem to move data up and down the list box and to transfer items between list boxes. AFAIK, I can only use those two methods if the row source type is set to value list and I don't know another way to do this.

So the row source would read something like col1;col2;col3;...etc for each row. It isn't in SQL form. So I have no idea how to sort that.

Maybe if you are willing to show me your examples with code I can figure it out? But at the moment I have no idea what you are proposing. Sorry

 

[isladogs]

The examples shown are part of 2 different databases. Whilst could extract the code, it won't be for several hours. Which example looks more relevant?

In the meantime, why not upload what you have

 

[rede96]

The examples shown are part of 2 different databases. Whilst could extract the code, it won't be for several hours. Which example looks more relevant?

In the meantime, why not upload what you have

Ok sure. I can't right now as I'm just about to go out. But will in a short while.

Thanks

 

[arnelgp]

Here is a sample that will sort your listbox. At the moment it only sort the first column. See module1 code and the code on sort button of form1.

 

[rede96]

Here is a sample that will sort your listbox. At the moment it only sort the first column. See module1 code and the code on sort button of form1.

Thanks for the sample. I'm not sure how I can adapt it for multiple columns, maybe store each row source in an array as you've done in the sample. Anyway I will have a play around.

 

[rede96]

In the meantime, why not upload what you have

Below is the code I use to populate the first listbox. Each list box has 10 columns, the bound column is 1 and multi select is set to extended.

Dim strSQL As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstCount As Integer
Dim Addline As String
Dim rstWO As String
Dim rstPart As String
Dim rstDesc As String
Dim rstCell As String
Dim rstTAT As String
Dim rstAge As String
Dim rstLast As Date
Dim rstSSHours As Double
Dim rstReq As Date
Dim iPos As Integer
Dim MySort As Variant

' Ask for initial sort critera
MySort = MsgBox("Do you wish to sort by Date Recieved?", vbYesNoCancel)

Select Case MySort

    Case vbYes
    
    strSQL = "SELECT QryList_OpenStripSurvey.WONumber, QryList_OpenStripSurvey.PartNumber, QryList_OpenStripSurvey.Description, " & _
    "QryList_OpenStripSurvey.Cell, QryList_OpenStripSurvey.IntitalTAT, QryList_OpenStripSurvey.TATAge, QryList_OpenStripSurvey.SSRequested, " & _
    "QryList_OpenStripSurvey.LastStartDate, QryList_OpenStripSurvey.SSHours FROM QryList_OpenStripSurvey ORDER BY " & _
    "QryList_OpenStripSurvey.SSRequested, QryList_OpenStripSurvey.LastStartDate;"

    Case vbNo
        strSQL = "SELECT QryList_OpenStripSurvey.WONumber, QryList_OpenStripSurvey.PartNumber, QryList_OpenStripSurvey.Description, " & _
        "QryList_OpenStripSurvey.Cell, QryList_OpenStripSurvey.IntitalTAT, QryList_OpenStripSurvey.TATAge, QryList_OpenStripSurvey.SSRequested, " & _
        "QryList_OpenStripSurvey.LastStartDate, QryList_OpenStripSurvey.SSHours FROM QryList_OpenStripSurvey ORDER BY " & _
        "QryList_OpenStripSurvey.LastStartDate, QryList_OpenStripSurvey.SSRequested;"
    Case vbCancel
        Exit Sub

    Case Else
        Exit Sub

End Select
' Clear list prior to populating
Me.lstOpenStrips.RowSource = ""

' Set recordset
Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL)

' Check recordset is populated & count records
If Not (rst.EOF And rst.BOF) Then
    rst.MoveLast
    rst.MoveFirst
    rstCount = rst.RecordCount
    Me.txtTotalLoaded = rstCount
    iPos = 0 'Set to 0 as this is used to index each row
    
    ' Populate each row of list from recordset
    Do Until rst.EOF
        rstWO = Nz(rst!WONumber, "")
        rstPart = "'" & Nz(rst!PartNumber, "") & "'"
        rstDesc = "'" & Nz(rst!Description, "") & "'"
        rstCell = Nz(rst!Cell, "")
        rstTAT = Nz(rst!IntitalTAT, "")
        rstAge = Nz(rst!TATAge, "")
        rstReq = Nz(rst!SSRequested)
        rstLast = Nz(rst!LastStartDate)
        rstSSHours = Nz(rst!SSHours)
        Addline = iPos & ";" & rstWO & ";" & rstPart & ";" & rstDesc & ";" & rstCell & ";" & rstTAT & ";" & rstAge & ";" & rstReq & ";" & rstLast & ";" & rstSSHours
        Me.lstOpenStrips.AddItem Addline
        iPos = iPos + 1
        rst.MoveNext
    Loop
End If

End Sub

And here is a sample of the code I use to move rows to the second list box.

Private Sub CmdWanted_Click()
Dim IntX As Integer
Dim ItemsCount As Integer
Dim ItemS As Variant
Dim ItemI As Integer
Dim iPos As Integer
Dim rstWO As String
Dim rstPart As String
Dim rstDesc As String
Dim rstCell As String
Dim rstTAT As String
Dim rstAge As String
Dim rstLast As Date
Dim Addline As String
Dim rstSSHours As Double
Dim IntY As Integer
Dim ItemR As Integer
Dim rstReq As Date
Dim tmpiPos As Integer
Dim ItemAr() As Integer 'Array for storing row index to be deleted after transfer

'Set variables
IntX = 0
ItemsCount = Me.lstOpenStrips.ItemsSelected.Count
'exit sub if nothing selected
If ItemsCount = 0 Then Exit Sub
'Redim ItemArray
ReDim ItemAr(0 To (ItemsCount - 1))

' Check if any items have been selected
If ItemsCount = 0 Then Exit Sub

' Cycle thrugh items selected and store row details.
For Each ItemS In Me.lstOpenStrips.ItemsSelected
    ItemI = ItemS
    iPos = Nz(Me.lstOpenStrips.Column(0, ItemI))
    rstWO = Nz(Me.lstOpenStrips.Column(1, ItemI))
    rstPart = "'" & Nz(Me.lstOpenStrips.Column(2, ItemI)) & "'"
    rstDesc = "'" & Nz(Me.lstOpenStrips.Column(3, ItemI)) & "'"
    rstCell = Nz(Me.lstOpenStrips.Column(4, ItemI))
    rstTAT = Nz(Me.lstOpenStrips.Column(5, ItemI))
    rstAge = Nz(Me.lstOpenStrips.Column(6, ItemI))
    rstReq = Nz(Me.lstOpenStrips.Column(7, ItemI))
    rstLast = Nz(Me.lstOpenStrips.Column(8, ItemI))
    rstSSHours = Nz(Me.lstOpenStrips.Column(9, ItemI))
    ' Generate list row data
    Addline = iPos & ";" & rstWO & ";" & rstPart & ";" & rstDesc & ";" & rstCell & ";" & rstTAT & ";" & rstAge & ";" & rstReq & ";" & rstLast & ";" & rstSSHours
    ' Add line to List
    Me.lstPriorityList.AddItem Addline
    ' Store row index for delete after transfer
    ItemAr(IntX) = ItemI
    IntX = IntX + 1
Next

' Delete rows that have been transfered
For IntY = 0 To IntX - 1
    ItemR = ItemAr(IntY) - IntY
    tmpiPos = Nz(Me.lstOpenStrips.Column(0, ItemR)) + 1
    Me.lstOpenStrips.RemoveItem (ItemR)
Next IntY

End Sub

 

[isladogs]

I'm busy on my own projects this evening but here's part of the code used in the first set of screenshots in post 5 which show a student list. That's also a multiselect listbox

Sorting is very simple to code

Default - Sort A-Z

Me.lstPupils.RowSource = "SELECT DISTINCTROW PupilData.PupilID," & _
            " PupilData!Surname & ' ' & PupilData!Forename & '  ' & PupilData!YearGroup & PupilData!TutorGroup AS Name, " & _
            " PupilData.Surname, PupilData.Forename, PupilData.YearGroup, PupilData.TutorGroup, PupilData.Active" & _
            " FROM PupilData" & _
            " WHERE(((PupilData.Active) = Yes))" & _
            " ORDER BY PupilData.Surname, PupilData.Forename;"

Sort By Year Group

Me.lstPupils.RowSource = "SELECT PupilData.PupilID, PupilData.House, PupilData.Surname, PupilData.Forename," & _
        " PupilData.YearGroup, PupilData.TutorGroup, PupilData.Active, ICTData.[School e-mail]" & _
        " FROM ICTData INNER JOIN PupilData ON ICTData.PupilID = PupilData.PupilID" & _
        " WHERE (((PupilData.Active) = True))" & _
        " ORDER BY PupilData.YearGroup, PupilData.Surname, PupilData.Forename;"

Sort By Tutor Group

Me.lstPupils.RowSource = "SELECT PupilData.PupilID, PupilData.House, PupilData.Surname, PupilData.Forename," & _
            " PupilData.YearGroup, PupilData.TutorGroup, PupilData.Active, ICTData.[School e-mail]" & _
            " FROM ICTData INNER JOIN PupilData ON ICTData.PupilID = PupilData.PupilID" & _
            " WHERE (((PupilData.Active) = True))" & _
            " ORDER BY PupilData.YearGroup, PupilData.TutorGroup, PupilData.Surname, PupilData.Forename;"

Filter By Year Group

intYear = Me.cboYear

Me.lstPupils.RowSource = "SELECT PupilData.PupilID, PupilData.House, PupilData.Surname, PupilData.Forename," & _
        " PupilData.YearGroup, PupilData.TutorGroup, PupilData.Active, ICTData.[School e-mail]" & _
        " FROM ICTData INNER JOIN PupilData ON ICTData.PupilID = PupilData.PupilID" & _
        " WHERE (((PupilData.Active) = True) AND ((PupilData.YearGroup) = " & intYear))" & _
        " ORDER BY PupilData.Surname, PupilData.Forename;"

In some other examples, I use code where clicking a sort button again reverses the sort order e.g. names from Z-A, year group from 11 to 7 etc

HTH

 

[rede96]

I'm busy on my own projects this evening but here's part of the code used in the first set of screenshots in post 5 which show a student list. That's also a multiselect listbox

Sorting is very simple to code

Default - Sort A-Z

Me.lstPupils.RowSource =.....

In some other examples, I use code where clicking a sort button again reverses the sort order e.g. names from Z-A, year group from 11 to 7 etc

HTH

Thanks for taking the time to post. Unfortunately I think you are missing the point.

Your are using SQL statements to sort a list box which will have it's row source type set to Table/Query am I correct? So sorting that is easy as you say.

I ONLY use SQL to populate the list box but the row source type MUST be set to value list in order to move items from one list box to a blank list box. This is because I am using the Listbox.AddItem and Listbox.RemoveItem methods
(See this link: https://msdn.microsoft.com/en-us/VBA/Access-VBA/articles/listbox-removeitem-method-access )

So your method of sorting will not work on this type of listbox as there is no easy way to generate a new SQL statement from a value list row source.

Of course I could create a new table based on the row source but that will be very messy and long winded.

I think the code sample posted by @arnelgp is similar to what I need. I just have to find a way to sort with multiple columns. The initial code I posted does this but only for a list box in Excel. I can't seem to find the correct reference in my VBA module to get it to work in Access.

 

[isladogs]

Thanks for taking the time to post. Unfortunately I think you are missing the point.

Your are using SQL statements to sort a list box which will have it's row source type set to Table/Query am I correct? So sorting that is easy as you say.

I ONLY use SQL to populate the list box but the row source type MUST be set to value list in order to move items from one list box to a blank list box. This is because I am using the Listbox.AddItem and Listbox.RemoveItem methods
(See this link: https://msdn.microsoft.com/en-us/VBA/Access-VBA/articles/listbox-removeitem-method-access )

So your method of sorting will not work on this type of listbox as there is no easy way to generate a new SQL statement from a value list row source.

Of course I could create a new table based on the row source but that will be very messy and long winded.

I think the code sample posted by @arnelgp is similar to what I need. I just have to find a way to sort with multiple columns. The initial code I posted does this but only for a list box in Excel. I can't seem to find the correct reference in my VBA module to get it to work in Access.

No I'm not missing the point.
If you remember I asked you which part of my previous post would be most useful to you.
However you didn't answer the question so I made a decision to focus on sorting & filtering

I explained in an earlier post that its also possible to do all the following using table/query row sources:
a) move items up/down within a listbox
b) add items / remove items from a list
c) move items from one listbox to another

I just didn't have time to add code for that as well on this occasion
I don't personally think its long winded or messy doing any of this
However I won't be offended if you choose to continue with your current approach

 

[jdraw]

REDE96,

You were going to upload what you have...??

 

[rede96]

No I'm not missing the point.
If you remember I asked you which part of my previous post would be most useful to you.
However you didn't answer the question so I made a decision to focus on sorting & filtering

I explained in an earlier post that its also possible to do all the following using table/query row sources:
a) move items up/down within a listbox
b) add items / remove items from a list
c) move items from one listbox to another

I just didn't have time to add code for that as well on this occasion
I don't personally think its long winded or messy doing any of this
However I won't be offended if you choose to continue with your current approach

Ah ok. Sorry I must have misunderstood. I’ve spent a number of days looking up ways to manipulate a multi select list box and the method I posted was the only way I found. So I am not set on any method other than what works

But I have no idea how to add / remove items or move items up and down in a list box using the table / query row source. Nor did I manage to find any info on doing it that way.

So if you get the time and are willing to post some examples then of course I’d be very greatful. But in any case I appreciate your time to respond. Thanks.

 

[DougMVP]

Seems like the other respondent never appreciated that the listbox was of the Value List type.

I came here looking for the same thing, and have since come up with the following method of loading the data from a mult-column listbox into an array

Dim i As Long, j As Long
Dim varlist As Variant
With Me.lstMerge
ReDim varlist(.ListCount, 3)
For i = 0 To .ListCount - 1
For j = 0 To 2
varlist(i + 1, j + 1) = .Column(i, j)
Next j
Next i
End With

 

[isladogs]

Welcome to AWF Doug (Steele?)

 

[DougMVP]

No, Doug Robbins.

To complete the sorting method, I dumped the array into Excel and then sorted it there before loading it back into the list box, using the following code:

Dim i As Long, j As Long
Dim varlist As Variant
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim bstartapp As Boolean
With Me.lstMerge
    ReDim varlist(3, .ListCount)
    For i = 1 To 3
        For j = 1 To .ListCount
            varlist(i, j) = .Column(i - 1, j - 1)
        Next j
    Next i
End With
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
    bstartapp = True
    Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Add
Set xlsheet = xlbook.Worksheets(1)
With xlsheet.Range("A1")
    For i = 1 To UBound(varlist, 1)
        For j = 1 To UBound(varlist, 2)
            .Offset(j - 1, i - 1) = varlist(i, j)
        Next j
    Next i
End With
With xlsheet
    i = .Range("A1").CurrentRegion.rows.Count
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=xlsheet.Range("A1:A" & i), SortOn:=0, Order:=1, DataOption:=0
    .Sort.SortFields.Add2 Key:=xlsheet.Range("B1:B" & i), SortOn:=0, Order:=1, DataOption:=0
    .Sort.SortFields.Add2 Key:=xlsheet.Range("C1:C" & i), SortOn:=0, Order:=1, DataOption:=0
    With .Sort
        .SetRange xlsheet.Range("A1").CurrentRegion
        .Header = False
        .MatchCase = False
        .SortMethod = 1
        .Apply
    End With
    varlist = .Range("A1").CurrentRegion
End With
With Me.lstMerge
    For i = .ListCount - 1 To 0 Step -1
        .RemoveItem (i)
    Next i
    For i = 1 To UBound(varlist, 1)
        .AddItem varlist(i, 1) & "," & varlist(i, 2) & "," & varlist(i, 3)
    Next i
End With
xlbook.Close False
If bstartapp = True Then
    xlapp.Quit
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
End Sub

 

[isladogs]

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