Code Library

NewSort(): Sort a Continuous Form by Clicking on the Column Label

Sort a continuous form in MS Access by simply pointing at a column label. These functions make it easy.

Mike Wolfe

Sep 1, 2022 • 5 min read

Today's function provides a simple, but powerful, way for your users to sort the various columns of your continuous Microsoft Access forms.

This function–NewSort()–includes these features:

Toggles between ascending and descending sorts
Supports multi-column sorting
Works with "lightweight" form objects (those with no VBA code-behind)

The Code

Here's the sample code complete with notes on several bug fixes I've had to implement over the years:

'---------------------------------------------------------------------------------------
' Procedure : NewSort
' DateTime  : 6/12/2008 - 4/9/2015
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/newsort/
' Purpose   : Sort a continuous form by simply pointing at a column label.
' Requires  : UpdateOrderBy() function
' Usage     : Set the following properties in the label control(s) in the form header:
'           - OnMouseMove: =UseHand()
'           - OnClick: =NewSort([Form], "FieldToSort")
'           : To set the initial sort order, pass multiple field names
'           - OnLoad: =NewSort([Form], "1stFieldToSort", "2ndFieldToSort")
'           : To use the recordsource's sort order, pass no field names
'           - OnLoad: =NewSort([Form])
'           : To sort a field in descending order first (subsequent clicks always toggle)
'           - OnClick: =NewSort([Form], "LastPmtDate DESC")
'
' Changelog :
'  8/24/09  - Added Frm.OrderByOn = False line to fix bug where interaction with
'               SetScrollBarDisplay would prevent OrderBy clause from being completely
'               replaced by a multiple field name sort
' 11/15/09  - Bug fix: Enter parameter 'LastPmtDate DESC DESC'
'  4/12/11  - Bug fix: Left over ORDER BY was filtering out all records when OnLoad: =NewSort(Form)
'  5/25/12  - Bug fix: [SQL Server] A column has been specified more than once in the order by list.
'                                   Columns in the order by list must be unique. (#169)
'  9/14/12  - Bug fix: Workaround for Access 2000 bug where updating the OrderBy clause
'               of a subform sets the Filter Off on the parent form
'  3/30/15  - Bug fix: exit immediately if the form has no RecordSource
'  4/ 9/15  - Bug fix: Workaround for Workaround for Access 2000 bug fix of 9/14/12
'---------------------------------------------------------------------------------------
'
Function NewSort(Frm As Form, ParamArray FieldNames() As Variant)    'vv
Dim CommaPos As Long, NewOrderBy As String
Dim FieldName As Variant, PreferDesc As Boolean, SaveFilter As String
Dim UntrimmedClause As Variant, Clause As String, Clauses As Variant, i As Integer
    If Len(Frm.RecordSource) = 0 Then Exit Function
    
    On Error Resume Next
    Dim ParentFilterOn As Variant
    ParentFilterOn = Frm.Parent.FilterOn
    
    On Error GoTo 0

    'If single field is passed to function, then append to existing OrderBy clause...
    If UBound(FieldNames) = LBound(FieldNames) And Len(Frm.OrderBy) > 0 Then
        FieldName = Trim(FieldNames(LBound(FieldNames)))
        Frm.OrderBy = UpdateOrderBy(Frm.OrderBy, CStr(FieldName))
        Frm.OrderByOn = True
    Else
        '...create brand new OrderBy clause
        For Each FieldName In FieldNames
            NewOrderBy = Conc(NewOrderBy, FieldName)
        Next FieldName
        If Len(NewOrderBy) > 0 Then
            Frm.OrderBy = NewOrderBy
            Frm.OrderByOn = True
        Else
            Frm.OrderBy = ""
            Frm.OrderByOn = False
            If Frm.FilterOn Then
                SaveFilter = Frm.Filter
                Frm.RecordSource = Frm.RecordSource
                Frm.Filter = SaveFilter
                Frm.FilterOn = True
            Else
                Frm.RecordSource = Frm.RecordSource
            End If
        End If
    End If

    'Workaround for Access 2000 bug:
    If Not IsEmpty(ParentFilterOn) Then
        Dim SaveOrderByOn As Boolean
        SaveOrderByOn = Frm.OrderByOn
        Frm.Parent.FilterOn = ParentFilterOn
        Frm.OrderByOn = SaveOrderByOn
    End If

End Function

'NOTE: Add third angle bracket and remove Private token to enable DocTesting
'>> UpdateOrderBy("FinBsmt DESC, UnfinBsmt DESC", "UnfinBsmt DESC")
'UnfinBsmt DESC, FinBsmt DESC
'>> UpdateOrderBy("", "UnfinBsmt DESC")
'UnfinBsmt DESC
'>> UpdateOrderBy("FinBsmt DESC, UnfinBsmt DESC", "FinBsmt DESC")
'FinBsmt, UnfinBsmt DESC
'>> UpdateOrderBy("FName, LName", "LName")
'LName, FName
Private Function UpdateOrderBy(ExistingOrderBy As String, NewField As String) As String 'vv
Dim PreferDesc As Boolean, FieldName As String
Dim Clauses As Variant, Clause As String, UntrimmedClause As Variant, i As Integer
    
        If Len(ExistingOrderBy) = 0 Then
            UpdateOrderBy = NewField
            Exit Function
        End If
    
        'Allow user to indicate that the first sort for a column should be in descending order
        FieldName = NewField
        PreferDesc = Right(FieldName, 5) = " DESC"
        FieldName = Replace(FieldName, " DESC", "")
        
        Clauses = Split(ExistingOrderBy, ",")
        UpdateOrderBy = ""
        For Each UntrimmedClause In Clauses
            Clause = Trim(UntrimmedClause)
            If i = 0 Then
                If Left(Clause, Len(FieldName)) = FieldName Then
                    If Right(Clause, 4) = "DESC" Then
                        UpdateOrderBy = FieldName
                    Else
                        UpdateOrderBy = FieldName & " DESC"
                    End If
                Else
                    If PreferDesc Then
                        UpdateOrderBy = FieldName & " DESC"
                    Else
                        UpdateOrderBy = FieldName
                    End If
                    UpdateOrderBy = Conc(UpdateOrderBy, Clause)
                End If
            Else
                If Left(Clause, Len(FieldName)) <> FieldName Then
                    UpdateOrderBy = Conc(UpdateOrderBy, Clause)
                End If
            End If
            i = i + 1
        Next UntrimmedClause
End Function



'---------------------------------------------------------------------------------------
' Procedure : Conc
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/come-together/
' Date      : 1/23/2009 - 4/1/2015
' Purpose   : Concatenates two strings
' Notes     : Eliminates the need to strip off the leading/trailing delimiter when
'               building a string list
' 4/17/09   - If StartText is filled, but nextval is empty, then StartText is returned unchanged.
' 5/ 1/09   - Changed return type of conc from Variant to String.
' 4/ 1/15   - Allow passing Nulls as StartText.
'>>> Conc("1, 2, 3", "4")
' 1, 2, 3, 4
'>>> Conc("This", "that", " and ")
' This and that
'>>> Conc("Five", Null, " and ")
' Five
'>>> Conc(Null, "Dime", " and ")
' Dime
'>>> "#" & Conc(Null, Null) & "#"
' ##
'---------------------------------------------------------------------------------------
'
Function Conc(StartText As Variant, NextVal As Variant, _
              Optional Delimiter As String = ", ") As String
    If Len(Nz(StartText)) = 0 Then
        Conc = Nz(NextVal)
    ElseIf Len(Nz(NextVal)) = 0 Then
        Conc = StartText
    Else
        Conc = StartText & Delimiter & NextVal
    End If
End Function

Usage

There are usage notes in the code comments, but here is the high-level overview:

Create Label controls in the Form Header section to serve as column headers
Set the On Click event for each label to =NewSort([Form], "MyColumnName")
[OPTIONAL] Set the On Mouse Move event to =UseHand()
[OPTIONAL] Set the form's On Load event to =NewSort([Form], "MyFirstColNameToSortBy", "MySecondColNameToSortBy") (passing multiple field names resets the form's Order By property)

Sample Database

Below you will find a link to a sample database that shows the NewSort in action. It also demonstrates a couple of other common features that I've written about in the past, including: