Sorting listbox contents

[Guest]

I have a 5 col. listbox whose content is determined programmatically. What I
would like to do is to allow the user to click a column heading to sort by
that column's value. Specifically here is what happens.

The listbox shows information about the jobs we currently have in house. I
have buttons on the form containing the listbox to allow the user to show
only "Open" jobs or "All" jobs. When the user clicks on the "Show Open Jobs"
button I change the listbox's RowSource Property to a particular Query. Same
for the "Show All Jobs" except it is a different Query. I did have it where
the user could click on a column heading and soort the listbox's contents but
I achieved this by creating another query same as the first but with a Sort
applied to it and applying this Query to the RowSource property. For example,
one query is "qryShowAllJobs". One of the sort queries was
"qryShowAllJobsByDate" which was identical to the original "qryShowAllJobs"
but with a Sort applied to it. I hope all of this is clear!

Anyway, the number of criteria by which I want to sort is growing and it is
getting rather unfeasible to write a query for each and every sort
possibility. So I was wondering if anyone could suggest a solution? Is it
possible to add a Sort criteria to the query when you call it?

Me.lstBox.RowSource = qryName & "ORDER BY date"

I can see that if I were using an SQL statement as the RowSource property
how I could alter it on-the-fly as it were. But where would I store the SQL
statements in the first place. Add a subroutine that builds the SQL statement
based on criteria passed to it?

As always, any suggestions are appreciated!

 

[Guest]

Seems to me that you would be better off with a subform in datasheet view.

Steve

 

[John Spencer]

Here is a VBA function that I use on listboxes. Read the limitations. It
works for me and my users in 2000 to 2003. No idea if it will work
correctly in 2007.

Public Sub sSortListBox(anyListbox As Control, _
Button As Integer, _
Shift As Integer, _
X As Single)
'Purpose: Sort list box by column when column is right-clicked
'Author: Copyright by John Spencer
'Version Date: 04-14-2004
'Limitations:
' No Horizontal scroll bar in listbox
' RowSource must be query
' Uses DAO code; not tested with ADP
'Permission to use in applications is granted to all
'with the understanding that
'credit is given to the author.
'No warrantee or guaranty is given - use at your own risk.
'
'Code to sort list in ascending/descending order
'depending on which column is right-clicked
'and whether shift key is pressed.
'Uses the SQL syntax of specifying a column number as
'the sort column -
' SELECT ... FROM ... ORDER BY N
'- where N is integer reflecting the position of a field in SELECT clause.
'Install call to this code in the Mouse Down event of a listbox.
'Example -
' sSortListBox Me.SomeListbox, Button, Shift, X
'---------------------------------------------------------------------
'---------------------------------------------------------------------
'In the listbox's Mouse Up event add code to cancel the Mouse up event.
' If Button = acRightButton Then DoCmd.CancelEvent
'That line will stop any popup menu from appearing.
'---------------------------------------------------------------------
'---------------------------------------------------------------------

Dim strSQL As String
Dim vGetWidths As Variant
Dim vArWidths() As Variant
Dim iColCount As Integer, iColNumber As Integer
Dim iLoop As Integer
Dim iColWidthSum As Integer
Dim iUndefined As Integer
Dim iDefaultWidth As Integer
Dim strOrderBy As String
Const strListSeparator As String = ";" 'list Separator
'If your list separator is not a ";"
'you will need to change the ";" to your list separator

On Error GoTo ERROR_sSortListBox

If Button <> acRightButton Then
'only sort based on right button being clicked

ElseIf anyListbox.RowSourceType <> "table/query" Then
'only sort listbox based on queries
MsgBox "List box must use a query as it's row source"

ElseIf Len(anyListbox.RowSource) = 0 Then
'Nothing there, so ignore the click

ElseIf Not (InStr(1, Trim(anyListbox.RowSource), "Select", vbTextCompare)
= 1 _
Or InStr(1, Trim(anyListbox.RowSource), "Parameters", vbTextCompare) =
1) Then
'If rowsource does not start with SELECT or PARAMETERS then
'assume it is a table not a query
MsgBox "List box must use a query as its row source"

ElseIf anyListbox.ColumnCount <> _
DBEngine(0)(0).CreateQueryDef("", anyListbox.RowSource).Fields.Count
Then
'Column count must be correctly set, otherwise this routine
'could cause errors. Column count set less than actual field count
'will cause subscript errors. Column count set higher than actual
'field count can cause listbox to display nothing if "Extra" column
'is clicked.
MsgBox "List box column count does not match query field count!"

Else 'passed the error checks

With anyListbox
'Column count must be correctly set, otherwise this routine
'could cause errors. Column count set less than actual column count
'will cause subscript errors. Column count set higher than actual
'column count can cause listbox to display nothing if "Extra"
column
'is clicked.
iColCount = .ColumnCount
ReDim vArWidths(iColCount - 1, 0 To 1)

'If you are using Access 97 then you will need a custom function to
'perform the parsing of the column widths into an array.
vGetWidths = Split(.ColumnWidths, strListSeparator, -1,
vbTextCompare)

'Assign values to array that holds length and running sum of length
For iLoop = 0 To UBound(vGetWidths)
iColWidthSum = iColWidthSum + Val(vGetWidths(iLoop))
vArWidths(iLoop, 1) = iColWidthSum
vArWidths(iLoop, 0) = vGetWidths(iLoop)
Next iLoop

'Adjust any colwidths that are unspecified:
'The minimum is the larger of 1440
'or the remaining available width of the list box
'divided by number of columns
'with unspecified lengths.
For iLoop = 0 To iColCount - 1
If Len(vArWidths(iLoop, 0) & vbNullString) = 0 Then
iUndefined = iUndefined + 1
End If
Next iLoop

If iUndefined <> 0 Then
iDefaultWidth = (.Width - iColWidthSum) / iUndefined
End If

If iDefaultWidth > 0 And iDefaultWidth < 1440 Then
MsgBox "Sorry! Can't process listboxes with horizontal
scrollbars"
Exit Sub 'Horizontal scroll bar present
Else
'recalculate widths and running sum of column widths
iColWidthSum = 0
For iLoop = 0 To iColCount - 1
If Len(vArWidths(iLoop, 0) & vbNullString) = 0 Then
vArWidths(iLoop, 0) = iDefaultWidth
End If
iColWidthSum = iColWidthSum + Val(vArWidths(iLoop, 0))
vArWidths(iLoop, 1) = iColWidthSum

Next iLoop
End If

'Set right edge of last column equal to width of listbox
vArWidths(iColCount - 1, 1) = .Width

'Determine which column was clicked
For iLoop = 0 To iColCount - 1
'If X - .Left <= vArWidths(iLoop, 1) Then
If X <= vArWidths(iLoop, 1) Then
iColNumber = iLoop
Exit For
End If
Next iLoop
iColNumber = iColNumber + 1 'adjust since iLoop is 0 to n-1

'rebuild sql statement
If iColNumber > 0 And iColNumber <= iColCount Then
strSQL = Trim(.RowSource)

If Right(strSQL, 1) = ";" Then strSQL = Left(strSQL,
Len(strSQL) - 1)

iLoop = InStr(1, strSQL, "Order by", vbTextCompare)
If iLoop > 0 Then
strOrderBy = Trim(Mid(strSQL, iLoop + Len("Order by")))
strSQL = Trim(Left(strSQL, iLoop - 1))
End If

'Build the appropriate ORDER BY clause
If Shift = acShiftMask Then
'If shift key is down force sort to desc on selected column
strOrderBy = " Order By " & iColNumber & " Desc"

ElseIf Len(strOrderBy) = 0 Then
'If no prior sort then sort this column ascending
strOrderBy = " Order by " & iColNumber & " Asc"

ElseIf InStr(1, strOrderBy, iColNumber & " Asc", vbTextCompare)

0 Then

'If already sorted asc on this column then sort descending
strOrderBy = " Order By " & iColNumber & " Desc"

ElseIf InStr(1, strOrderBy, iColNumber & " Desc", vbTextCompare)

0 Then

'If already sorted desc on this column then sort Ascending
strOrderBy = " Order By " & iColNumber & " Asc"

Else
strOrderBy = " Order by " & iColNumber & " Asc"
End If

strSQL = strSQL & strOrderBy
.RowSource = strSQL

End If 'Rebuild SQL if col number is in range 1 to number of
columns
End With 'current list
End If 'Passed error checks

EXIT_sSortListBox:
Exit Sub

ERROR_sSortListBox:
Select Case Err.Number
Case 9 'Subscript out of range
MsgBox Err.Number & ": " & Err.Description & _
vbCrLf & vbCrLf & "Check column count property of list
box.", _
vbInformation, "ERROR: sSortListBox"

Case Else 'unexpected error
MsgBox Err.Number & ": " & Err.Description, vbInformation, _
"ERROR: sSortListBox"
End Select

Resume EXIT_sSortListBox
End Sub

--
John Spencer
Access MVP 2002-2005, 2007
Center for Health Program Development and Management
University of Maryland Baltimore County
..

 

[Guest]

Thanks guys. I will check out both suggestions.

Steven