Sorting a list-box by clicking its column headings

So you've got a list-box on a form with a number of columns. Wouldn't it be nice if you could click on the column headings to dynamically sort the list-box's contents by the relevant column? Well there's probably a sharp way to do this but I haven't found it yet. Instead, let me show you the somewhat clunky method I use; it lets you sort in ascending order by left-clicking a column heading and descending order by right-clicking the heading or, if you prefer, to toggle sort order with repeated left-clicks.

How does it work? Well, it's based around the list-box's MouseDown event and uses the position of the mouse pointer (its X and Y co-ordinates) over the list-box to decide whether it's over a column heading or not. See, I told you it was clunky! The important thing to remember here is that these co-ordinates are measured in twips - to help you with your conversions, there are 1440 twips in an inch or 567 twips in a centimetre. Also, the co-ordinate 0,0 is the top-left corner of the list-box.

In the example shown, I've got a list-box called lisSummary with a Row Source of "SELECT Surname, Forename, Department FROM tblStaff;" and Column Heads set to Yes. For simplicity, each column is set to be 3cm (that's 1701 twips, lest we forget) wide.

Private Sub lisSummary_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Y <= 225 Then 'This is the right height for column-headings in 8pt MS Sans Serif
    Dim strOrd As String, strSQL As String
    If Button = 1 Then strOrd = " Asc;" Else strOrd = " Desc;" 'Left-click sorts ASC, right-click sorts DESC
    strSQL = "SELECT Surname, Forename, Department FROM tblStaff ORDER BY "
    Select Case X 'Compile the OrderBy clause
    Case 0 To 1700
        strSQL = strSQL & "Surname " & strOrd
    Case 1701 To 3401
        strSQL = strSQL & "Forename " & strOrd
    Case Else
        strSQL = strSQL & "Department " & strOrd
    End Select
    lisSummary.RowSource = strSQL 'Apply the new recordsource
    lisSummary.Requery
End If
End Sub

You could modify this code to toggle the sort order on a column when you repeatedly left-click on it, if you'd prefer. Here's how:

Private Sub lisSummary_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then 'Check the left mouse button has been clicked, not the right
    If Y <= 225 Then 'This is the right height for column-headings in 8pt MS Sans Serif
        Dim strOrd As String, strSQL As String
        If Right$(lisSummary.RowSource, 5) = " Asc;" Then
            strOrd = " Desc;" 'Sort DESC if currently sorted ASC
        Else
            strOrd = " Asc;" 'Sort ASC if currently sorted DESC or for the first sort
        End If
        strSQL = "SELECT Surname, Forename, Department FROM tblStaff ORDER BY "
        Select Case X 'Compile the OrderBy clause
        Case 0 To 1700
            strSQL = strSQL & "Surname " & strOrd
        Case 1701 To 3401
            strSQL = strSQL & "Forename " & strOrd
        Case Else
            strSQL = strSQL & "Department " & strOrd
        End Select
        lisSummary.RowSource = strSQL 'Apply the new recordsource
        lisSummary.Requery
    End If
End If
End Sub