Callback functions in Microsoft Access VBA. Part 3

Little known feature of Microsoft Access

Callback functions can be a little hard to get a hold of but, once you master the technique, they can meet just about any need, no matter how complex.

This series of three articles will cover:

The basics of callback functions
Making the callback function configurable
Sharing one callback function between several controls

This is the third article. Links to the first and second articles can be found at the bottom of this article.

One function, multiple controls

If you use several callback functions in an application, most likely they will be used by individual controls (combobox or listbox). Sometimes you may wish to use one callback function for several controls. This will pose no problem as long as the function has a fixed configuration or, if it can be reconfigured, the same configuration should be used for all the controls using this function. Also, even if configured dynamically, one function can be used for multiple controls, if these are located on individual forms that are not likely to be open at the same time.

However, there can be scenarios where multiple controls are placed on the same form and could use the same callback function but with different configurations. A simple solution to this could be to duplicate the full code of the function having, say:

MyCallbackFunction1
MyCallbackFunction2

Likewise, the configurating functions could be duplicated:

MyConfigFunction1
MyConfigFunction2

But it is easy to see the limits of this method.

To do it smarter, the callback function should be able to distinguish between the calling controls and to store the individual configurations needed to server the controls.

An example is the function CallWeekdayDates which lists the dates of one weekday in an interval of dates. In addition to listing dates from different date intervals, it is easy to imagine a set up with seven combo- or listboxes each listing dates of one of the seven weekdays of a week. This is the full function:

' Callback function to list the dates of a weekday for a count of weeks.
' By default, the first day of the week according to the system settings
' is listed from the current date for twelve weeks.
'
' Optionally, any weekday, any start date, and any count of weeks can be
' set by the function ConfigWeekdayDates.
' Multiple controls - even a mix of comboboxes and listboxes - can be
' controlled simultaneously with individual settings.
'
' The format of the listed dates are determined by the controls' Format
' properties.
'
' Example for retrieval of selected value:
'
'   Dim SelectedDate As Date
'   SelectedDate = Me!ControlName.Value
'
' Typical settings for combobox or listbox:
'
'   ControlSource:  Bound or unbound
'   RowSource:      Leave empty
'   RowSourceType:  CallWeekdayDates
'   BoundColumn:    1
'   LimitToList:    Yes
'   AllowEditing:   No
'   ColumnCount:    Don't care. Will be set by the function
'   ColumnWidths:   Don't care. Will be overridden by the function
'   ListCount:      Don't care. Will be overridden by the function (ComboBox only)
'   Format:         Optional. A valid format for date values (ComboBox only)
'   Tag:            Optional. 1 to 255.
'                   Count of rows listed. If empty or 0, DefaultWeekCount is used
'
' 2021-03-01. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function CallWeekdayDates( _
    ByRef Control As Control, _
    ByVal Id As Long, _
    ByVal Row As Long, _
    ByVal Column As Variant, _
    ByVal Code As Integer) _
    As Variant

    ' Adjustable constants.
    '
    ' Initial count of weeks to list.
    ' Fixed for a listbox. A combobox can be reconfigured with function ConfigWeekdayDates.
    ' Will be overridden by a value specified in property Tag.
    Const DefaultWeekCount      As Integer = 16
    ' Format for the display column in a listbox.
    Const ListboxFormat         As String = "Short Date"
    ' Left margin of combobox to align the values on list with the formatted value displayed.
    ' Empiric value.
    Const LeftMargin            As Integer = 23

    ' Fixed constants.
    '
    ' Count of columns in the control.
    Const ColumnCount           As Integer = 2

    ' Function constants.
    '
    ' Array constants.
    Const ControlOption         As Integer = 0
    Const ApplyOption           As Integer = 1
    Const WeekdayOption         As Integer = 2
    Const StartDateOption       As Integer = 3
    Const RowCountOption        As Integer = 4
    Const FormatOption          As Integer = 5
    Const ControlDimension      As Integer = 2
    ' Control IDs.
    Const DefaultId             As Long = -1
    Const ResetId               As Long = 0
    Const ActionId              As Long = 1
    ' Setting IDs.
    Const DayOfWeekId           As Long = 1
    Const StartDateId           As Long = 2
    Const RowCountId            As Long = 3
    Const FormatId              As Long = 4

    Static ColumnWidth(0 To ColumnCount - 1)    As Integer
    Static DateFormat           As String
    Static OptionalValues()     As Variant
    Static Initialized          As Boolean

    Dim ControlName             As String
    Dim ControlIndex            As Integer
    Dim StartDate               As Date
    Dim FirstDate               As Date
    Dim DayOfWeek               As VbDayOfWeek
    Dim RowCount                As Integer
    Dim Value                   As Variant

    Select Case Code
        Case acLBInitialize
            ' Control settings.
            Control.ColumnCount = ColumnCount           ' Set the colum count of the control.
            Control.ColumnWidths = MinimalColumnWidth   ' Record width of first column. This is used for a requery.
            ColumnWidth(0) = HiddenColumnWidth          ' Hide the bound (value) column.
            ColumnWidth(1) = DefaultColumnWidth         ' Set the width of the display column to the default width.
            If Control.ControlType = acComboBox Then
                ' Set the date format later.            ' Retrieve the display format from the combobox's Format property.
                Control.LeftMargin = LeftMargin         ' Adjust left margin of combobox.
            Else
                DateFormat = ListboxFormat              ' Set the display format for the listbox.
            End If

            If Not Initialized Then
                ' Array for optional values has not been dimmed in this session.
                ReDim OptionalValues(ControlOption To FormatOption, 0 To 0)
                Initialized = True
            End If

            ' Initialize.
            Value = True                                ' True to initialize.
        Case acLBOpenAsVariant
            ControlName = Control.Name
            ' Find or create the index of the current control.
            For ControlIndex = LBound(OptionalValues, ControlDimension) To UBound(OptionalValues, ControlDimension)
                If OptionalValues(ControlOption, ControlIndex) = ControlName Then
                    Exit For
                End If
            Next
            If ControlIndex > UBound(OptionalValues, ControlDimension) Then
                ' Add yet a control.
                ReDim Preserve OptionalValues(ControlOption To FormatOption, 0 To ControlIndex)
                OptionalValues(ControlOption, ControlIndex) = ControlName
            End If

            ' Id:       Action.
            ' Row:      Parameter id.
            ' Column:   Parameter value.
            Select Case Id
                Case DefaultId                          ' Default call.
                    If OptionalValues(ApplyOption, ControlIndex) = False Then
                        ' Apply initial/default settings.
                        OptionalValues(ControlOption, ControlIndex) = ControlName
                        OptionalValues(ApplyOption, ControlIndex) = True
                        ' Use system's first day of week.
                        OptionalValues(WeekdayOption, ControlIndex) = SystemDayOfWeek
                        OptionalValues(StartDateOption, ControlIndex) = Date
                        RowCount = Val(Control.Tag)
                        If RowCount = 0 Then
                            RowCount = DefaultWeekCount
                        End If
                        OptionalValues(RowCountOption, ControlIndex) = RowCount
                        ' If this is a combobox, retrieve the default format from its Format property.
                        If Control.ControlType = acComboBox Then
                            DateFormat = Control.Format
                        End If
                        OptionalValues(FormatOption, ControlIndex) = DateFormat
                    End If
                Case ResetId                            ' Custom call. Ignore custom settings for the current control.
                    OptionalValues(ApplyOption, ControlIndex) = False
                Case ActionId                           ' Custom call. Set one optional value.
                    ' Row:      The id of the parameter to adjust.
                    ' Column:   The value of the parameter.
                    Select Case Row
                        Case DayOfWeekId                ' Day of week.
                            OptionalValues(WeekdayOption, ControlIndex) = Column
                        Case StartDateId                ' Start date.
                            If VarType(Column) = vbDate Then
                                OptionalValues(StartDateOption, ControlIndex) = Column
                            End If
                        Case RowCountId                 ' Count of weeks to list.
                            OptionalValues(RowCountOption, ControlIndex) = Column
                        Case FormatId                   ' Format for display.
                            If VarType(Column) = vbString Then
                                OptionalValues(FormatOption, ControlIndex) = Column
                            End If
                    End Select
            End Select

            ' Do not return a value.
        Case acLBOpen
            ' Value will be rounded to integer, so multiply by 100. Howeever, a Single
            ' (as returned by Timer) will be rounded to even, so convert the value to Long.
            Value = CLng(Timer * 100)                   ' Autogenerated unique ID.
        Case acLBGetRowCount                            ' Get count of rows.
            ControlName = Control.Name
            ' Find the index of the current control.
            For ControlIndex = LBound(OptionalValues, ControlDimension) To UBound(OptionalValues, ControlDimension)
                If OptionalValues(ControlOption, ControlIndex) = ControlName Then
                    Exit For
                End If
            Next
            ' Retrieve current setting.
            RowCount = OptionalValues(RowCountOption, ControlIndex)
            Value = RowCount                            ' Set count of rows.
        Case acLBGetColumnCount                         ' Get count of columns.
            Value = ColumnCount                         ' Set count of columns.
        Case acLBGetColumnWidth                         ' Get the column width.
            Value = ColumnWidth(Column)                 ' Use preset column widths.
        Case acLBGetValue                               ' Get the data for each row.
            ControlName = Control.Name
            ' Find the index of the current control.
            For ControlIndex = LBound(OptionalValues, ControlDimension) To UBound(OptionalValues, ControlDimension)
                If OptionalValues(ControlOption, ControlIndex) = ControlName Then
                    Exit For
                End If
            Next
            ' Retrieve current settings.
            StartDate = OptionalValues(StartDateOption, ControlIndex)
            DayOfWeek = OptionalValues(WeekdayOption, ControlIndex)
            ' Retrieve and save for this ControlIndex the format for the
            ' next call of the function which will have Code = acLBGetFormat.
            DateFormat = OptionalValues(FormatOption, ControlIndex)
            ' Calculate the earliest date later than or equal to the start date.
            FirstDate = DateNextWeekday(DateAdd("d", -1, StartDate), DayOfWeek)
            ' Calculate the date for this row.
            Value = DateAdd("ww", Row, FirstDate)
        Case acLBGetFormat                              ' Format the data.
            If Column = 1 Then
                Value = DateFormat                      ' Apply the value or the display format.
            End If
        Case acLBClose                                  ' Do something when the form recalculates or closes.
            ' no-op.
        Case acLBEnd                                    ' Do something more when the form recalculates or closes.
            ' no-op.
    End Select

    ' Return Value.
    CallWeekdayDates = Value

End Function

The crucial part is the array OptionalValues. This holds and separates the parameters for each control calling the function.

At first, it is initialised to hold parameters for one control (one dimension: 0 To 0):

If Not Initialized Then
    ' Array for optional values has not been dimmed in this session.
    ReDim OptionalValues(ControlOption To FormatOption, 0 To 0)
    Initialized = True
End If

The count of elements is fixed and will be used to store the option values using these constants for better readability:

Const ControlOption         As Integer = 0
Const ApplyOption           As Integer = 1
Const WeekdayOption         As Integer = 2
Const StartDateOption       As Integer = 3
Const RowCountOption        As Integer = 4
Const FormatOption          As Integer = 5

Later, when a reconfiguration is called, a check is made if the calling control is known; if not, the array will be redimmed with one dimension more (ControlIndex) to also hold this control by its name:

ControlName = Control.Name
' Find or create the index of the current control.
For ControlIndex = LBound(OptionalValues, ControlDimension) To UBound(OptionalValues, ControlDimension)
    If OptionalValues(ControlOption, ControlIndex) = ControlName Then
        Exit For
    End If
Next
If ControlIndex > UBound(OptionalValues, ControlDimension) Then
    ' Add yet a control.
    ReDim Preserve OptionalValues(ControlOption To FormatOption, 0 To ControlIndex)
    OptionalValues(ControlOption, ControlIndex) = ControlName
End If

From the very first example of a callback function, Timer has been used to create a “unique” id for the calling control. Timer returns a Single with a resolution of about 1/18 second but, for some unknown reason, the internal variable of the function is a Long. This will, of course, round the value from Timer to the second which isn't enough to separate two or more controls, as the form, when loading, will initialise these asyncronously. To overcome this, the value is multiplied by 100:

' Value will be rounded to integer, so multiply by 100. Howeever, a Single
' (as returned by Timer) will be rounded to even, so convert the value to Long.
Value = CLng(Timer * 100)                   ' Autogenerated unique ID.

Now, with the OptionValues array and a more likely unique Id, parameters for several controls can be written and read - even asyncronously - without interfering with each other.

Running the function

The initial call of the function sets, for each control using the function, the *default parameters:

Select Case Id
    Case DefaultId                          ' Default call.
        If OptionalValues(ApplyOption, ControlIndex) = False Then
            ' Apply initial/default settings.
            OptionalValues(ControlOption, ControlIndex) = ControlName
            OptionalValues(ApplyOption, ControlIndex) = True
            ' Use system's first day of week.
            OptionalValues(WeekdayOption, ControlIndex) = SystemDayOfWeek
            OptionalValues(StartDateOption, ControlIndex) = Date
            RowCount = Val(Control.Tag)
            If RowCount = 0 Then
                RowCount = DefaultWeekCount
            End If
            OptionalValues(RowCountOption, ControlIndex) = RowCount
            ' If this is a combobox, retrieve the default format from its Format property.
            If Control.ControlType = acComboBox Then
                DateFormat = Control.Format
            End If
            OptionalValues(FormatOption, ControlIndex) = DateFormat
        End If

If later to be reconfigured, the function's action section is called. The dimension is controlled by ControlIndex which has been set to that of the control, and then the element holding the parameter can be set:

    Case ActionId                           ' Custom call. Set one optional value.
        ' Row:      The id of the parameter to adjust.
        ' Column:   The value of the parameter.
        Select Case Row
            Case DayOfWeekId                ' Day of week.
                OptionalValues(WeekdayOption, ControlIndex) = Column
            Case StartDateId                ' Start date.
                OptionalValues(StartDateOption, ControlIndex) = Column
            Case RowCountId                 ' Count of weeks to list.
                OptionalValues(RowCountOption, ControlIndex) = Column
            Case FormatId                   ' Format for display.
                If VarType(Column) = vbString Then
                    OptionalValues(FormatOption, ControlIndex) = Column
                End If
        End Select

If more than one parameter should be set, the function is called multiple time with different values for Row to match the elements of the array to be set.

If the calls to reconfigure the function are made from its configuration function (see later), there should be no reason to validate the values. If needed, an example of basic validation is shown for the format option.

Having the parameters set - default or customised - these are read when the values to be listed are retrieved and formatted:

Case acLBGetValue                               ' Get the data for each row.
    ControlName = Control.Name
    ' Find the index of the current control.
    For ControlIndex = LBound(OptionalValues, ControlDimension) To UBound(OptionalValues, ControlDimension)
        If OptionalValues(ControlOption, ControlIndex) = ControlName Then
            Exit For
        End If
    Next
    ' Retrieve current settings.
    StartDate = OptionalValues(StartDateOption, ControlIndex)
    DayOfWeek = OptionalValues(WeekdayOption, ControlIndex)
    ' Retrieve and save for this ControlIndex the format for the
    ' next call of the function which will have Code = acLBGetFormat.
    DateFormat = OptionalValues(FormatOption, ControlIndex)
    ' Calculate the earliest date later than or equal to the start date.
    FirstDate = DateNextWeekday(DateAdd("d", -1, StartDate), DayOfWeek)
    ' Calculate the date for this row.
    Value = DateAdd("ww", Row, FirstDate)
Case acLBGetFormat                              ' Format the data.
    If Column = 1 Then
        Value = DateFormat                      ' Apply the value or the display format.
    End If

When creating the date, a supporting function, DateNextWeekday, is used to find the first weekday following the specified start date. Essentially, it performs this calculation:

FirstDate = DateAdd("d", 7 - (Weekday(FromDate, DayOfWeek) - 1), FromDate)

Where FromDate is the day before StartDate to have StartDate included on the list of dates.
The format is only handled for column 1 as the first column (column 0) holds the true date value which has no format.

Reconfiguration

As for the previous callback function, a function, ConfigWeekdayDates, has been created that will reconfigure one, two, or all parameters and requery a control and the function in one go. It is very similar to the previous function, so it will not be listed or discussed here.

Multiple controls in action

To demonstrate the setup of multiple controls on one form, the form CallbackDemoWeekdayDates has been created. It contains one listbox and two comboboxes:

The listbox is set to list dates of the current weekday, and the two comboboxes are set to list dates of the first and the last weekday respectively.

A tiny detail is, that the Tag property of the comboboxes can be set to hold the default count of dates (rows) to be listed. This can be set later, as can the date range to be listed, and this will interact with the row count. The format can be adjusted as well by modifying the content of the Format textbox.

At load of the form, the three controls are reconfigured. It takes a little, but is not convoluted, so please study the in-line comments and notice the usage of the configuration function:

Private Sub Form_Load()

    Const DefaultRowCount   As Integer = 16

    Dim FirstDate           As Date
    Dim RowCount            As Long
    Dim DayOfWeek           As VbDayOfWeek

    ' Assign the first day of the week as the default selection.
    Me!Weekdays1.Value = SystemDayOfWeek
    Me!StartDate1.Value = Date
    ' Assign the last day of the week as the default selection.
    Me!Weekdays2.Value = (SystemDayOfWeek - 1 - 1 + DaysPerWeek) Mod DaysPerWeek + 1
    Me!StartDate2.Value = Date

    ' Adjust count of rows to be listed if set in property Tag.
    RowCount = Val(Me!WeekdayDates1.Tag)
    If RowCount = 0 Then
        RowCount = DefaultRowCount
    End If
    Me!DateRows1.Value = RowCount

    RowCount = Val(Me!WeekdayDates2.Tag)
    If RowCount = 0 Then
        RowCount = DefaultRowCount
    End If
    Me!DateRows2.Value = RowCount

    ' Calculate end dates to display.
    FirstDate = DateNextWeekday(DateAdd("d", -1, Me!StartDate1.Value), Me!Weekdays1.Value)
    Me!EndDate1.Value = DateAdd("ww", RowCount - 1, FirstDate)

    FirstDate = DateNextWeekday(DateAdd("d", -1, Me!StartDate2.Value), Me!Weekdays2.Value)
    Me!EndDate2.Value = DateAdd("ww", RowCount - 1, FirstDate)

    ' Retrieve and display the default date format from the comboboxes' Format property.
    Me!FormatDate1.DefaultValue = """" & Me!WeekdayDates1.Format & """"
    Me!FormatDate2.DefaultValue = """" & Me!WeekdayDates2.Format & """"

    ' Check if default weekday of the weekday selector is different from SystemDayOfWeek.
    DayOfWeek = Me!Weekdays1.Value
    If DayOfWeek <> SystemDayOfWeek Then
        ' Reconfig the list/combobox as the weekday to list is different from SystemDayOfWeek.
        ConfigWeekdayDates Me!WeekdayDates1, DayOfWeek
    End If
    DayOfWeek = Me!Weekdays2.Value
    If DayOfWeek <> SystemDayOfWeek Then
        ' Reconfig the list/combobox as the weekday to list is different from SystemDayOfWeek.
        ConfigWeekdayDates Me!WeekdayDates2, DayOfWeek
    End If

    DayOfWeek = Weekday(Date)
    If DayOfWeek <> SystemDayOfWeek Then
        ' Reconfig the list/combobox as the weekday to list is different from SystemDayOfWeek.
        ConfigWeekdayDates Me!ListWeekdayDates, DayOfWeek
    End If

End Sub

Though not necessary if the controls are reconfigured when loading the form, it may be a good idea to reset the parameters for the control when closing the form. This is very easy to do, passing the control as the only argument to the configuration function:

Private Sub Form_Unload(Cancel As Integer)

    ConfigWeekdayDates Me!ListWeekdayDates
    ConfigWeekdayDates Me!WeekdayDates1
    ConfigWeekdayDates Me!WeekdayDates2

End Sub

The form has a lot of code to control the interaction between the controls supporting the three listbox and comboboxes. This is, however, very specific for this form. For most other forms, the setup and context will be very different, so the details will not be listed or discussed here. Study the code to get inspiration - all steps are carefully commented.

Conclusion

It has been shown what steps are needed to create a reconfigurable callback function for Microsoft Access that can server multiple controls.

If you recapture the basics of callback functions or how to reconfigure a callback function, please review the first and the second article in this series:

Callback functions in Microsoft Access VBA. Part 1
Callback functions in Microsoft Access VBA. Part 2

Code and download

The full code and demos are attached for Microsoft Access 365.

Microsoft Access: CallbackDemo.accdb

At any time, full and updated code is available on GitHub: VBA.Callback

I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.

Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts.

Please do not forget to press the "Thumbs Up" button if you think this article was helpful and valuable for EE members.