Ms Access Continuous Form Dynamic Label
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.
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:
-
UseHand: Changing the Mouse Cursor in Microsoft Access -
HighlightRow: How to Highlight the Current Record in a Continuous Form -
Conc: Avoid trimming the delimiter when building strings in loops
NewSortSample.accdb
If you run into any trouble, please ask in the comments below.
Referenced articles
Come Together
Do you build strings in loops? Stop trimming the delimiter at the end of the loop. There's a better way.
Mike Wolfe
UseHand(): Changing the Mouse Cursor in Microsoft Access
A classic Microsoft Access mouse cursor trick gets simplified and updated for 64-bit VBA compatibility.
Mike Wolfe
How to Highlight the Current Record in a Continuous Form
Step-by-step instructions for applying a custom highlight to the currently selected record in a continuous form in Microsoft Access.
Mike Wolfe
Source: https://nolongerset.com/newsort/
0 Response to "Ms Access Continuous Form Dynamic Label"
Post a Comment