I started using the SDOpenAI plugin to write a class that could take multiple form control input values and create a string for a filter output for a form. It did a simple and respectable job in accomplishing my task, but as I started implementing it, I started wanting a lot more from it.

I ended up modifying everything in the original AI generated class.

I created a new single class for form controls so I could use WithEvents and trap the OnChange event for any number of text controls.

I updated the original class to apply the filter to a form as well and needed to have the class take the form that the filter should apply to (in my case it was a subform and the controls were on it’s parent form).

Then I needed to tell the class which fields the values applied to on the final form. This worked for a couple of the filters, but then I wanted to create filters for some combo boxes in the continuous form that did not have the displayed value in the recordset. Uh-oh, but no problem, instead of specifying the recordset field name, I wrote the clause that should go with it with the place for the value embedded in the definition. Yikes.

It ended up being a lot more in depth than I thought, but I created a function on the form to test for the existence of the class and reload it if it wasn’t there. I put this in Form OnOpen and Form Activate. The reason for this is because during development I’m often doing things that reset the VBA environment and my forms will then forget and reset their entire state. This will make sure if that happens, it will get reinstantiated. So here’s the code in the form:

'Form Code
Option Compare Database 
Option Explicit 
Private frmFilter As FormFilter 

Private Sub setff() 
    If frmFilter Is Nothing Then 
        Set frmFilter = New FormFilter 
        frmFilter.Init Array( _ 
            Array(Me.fltPartNumber, "[PartNumber] Like '*[[val]]*'"),_ 
            Array(Me.fltFamilyDescription, "[FamilyNumber] In (SELECT FamilyNumber FROM FamilyData WHERE [Description] Like '*[[val]]*')"),_ 
            Array(Me.fltColor, "ColorNum Like '*[[val]]*'"),_ 
            Array(Me.fltFamilyNumber, "[FamilyNumber] Like '*[[val]]*'") _ 
        ),Me.SubEditPartNumbers.Form 
    End If 
End Sub 

' This is attached to a button on the form to clear all the filter boxes
Private Sub cmdClearFilters_Click() 
    setff 
    frmFilter.ClearFilters 
End Sub 

Private Sub Form_Activate() 
    setff 
End Sub 

Private Sub Form_Open(Cancel As Integer) 
    Me.Detail.BackColor = GetAppAltColor() 
    setff 
End Sub 

The Init function for the class takes an array of arrays. Each element of the main array contains a 2 element array with the form control with the filter value and a definition it should use to filter the form. The second argument other than the array is the form to be filtered by these controls. Be careful using subforms like this. If you mess with changing the ControlSource of the subform control this will reset that object and the FormFilter form reference will no longer be valid. That’s not a problem for me on this form because it’s just a straight up subform I’m not loading with code.

Now here’s the FormFilter class:

'FormFilter Class
Option Compare Database 
Option Explicit 

Private pFields As Collection 
Private pForm As Access.Form 

Private Sub Class_Initialize() 
    Set pFields = New Collection 
End Sub 

Public Sub Init(arrControlsAndColumns As Variant,frmToFilter As Access.Form) 
    Dim itm As Variant,fld As FormFilterField,ctl As Access.Control 
    Set pForm = frmToFilter 
    If Not IsArray(arrControlsAndColumns) Then GoTo ExitSub 
    For Each itm In arrControlsAndColumns 
        If Not IsArray(itm) Then GoTo SkipLoop 
        Set fld = New FormFilterField 
        Set ctl = itm(0) 
        fld.Init ctl,CStr(itm(1)),Me 
        pFields.Add fld 
SkipLoop: 
    Next itm 
ExitSub: 
    Set fld = Nothing 
    Set itm = Nothing 
End Sub 

Public Sub ApplyFilter() 
    Dim strFilter As String 
    strFilter = GetFilterString() 
    pForm.Filter = strFilter 
    If strFilter <>  "" Then pForm.FilterOn = True 
End Sub 

Public Sub ClearFilters() 
    Dim itm As Variant 
    For Each itm In pFields 
        itm.Criteria =  ""
    Next itm 
    pForm.Filter =  ""
End Sub 

Private Function GetFilterString() As String 
    Dim filterString As String 
    Dim i As Long 
    Dim crtUsed As Long 
    
    ' Build the filter string
    For i = 1 To pFields.Count 
        If pFields(i).Criteria =  "" Then GoTo SkipLoop 
        If crtUsed > 0 Then 
            filterString = filterString &  " AND "
        End If 
        filterString = filterString & Replace(pFields(i).ColumnName, "[[val]]",pFields(i).Criteria) 
        crtUsed = crtUsed + 1 
SkipLoop: 
    Next i 
    
    GetFilterString = filterString 
End Function 

Private Sub Class_Terminate() 
    Set pFields = Nothing 
    Set pForm = Nothing 
End Sub 

And the class for each control so that I could sync all the events for those controls:

'FormFilterField Class
Option Compare Database 
Option Explicit 

Private WithEvents ctl As Access.TextBox 
Private parent As FormFilter 
Private rsColumn As String 

Public Sub Init(AccessControl As Access.Control,rsColumnName As String,FormFilterObject As FormFilter) 
    Set ctl = AccessControl 
    Set parent = FormFilterObject 
    rsColumn = rsColumnName 
    ctl.OnChange =  "[Event Procedure]"
End Sub 

Public Property Get Criteria() As String 
    If Screen.ActiveControl.Name = ctl.Name Then 
        Criteria = Nz(ctl.Text, "") 
    Else 
        Criteria = Nz(ctl.value, "") 
    End If 
End Property 

Public Property Let Criteria(ByVal value As String) 
    ctl.value = value 
End Property 

Public Property Get ColumnName() As String 
    ColumnName = rsColumn 
End Property 

Public Property Let ColumnName(ByVal value As String) 
    rsColumn = value 
End Property 

Private Sub Class_Terminate() 
    Set parent = Nothing 
    Set ctl = Nothing 
End Sub 

Private Sub ctl_Change() 
    parent.ApplyFilter 
End Sub 

The final result on the form looks something like this:

Sign up For a Daily Email Adventure in Microsoft Access

Every business day (typically M-F), I'll send you an email with information about my ongoing journey as an advanced Access application developer. It will be loaded with my tips and musings.

Subscribe

We won't send you spam. Unsubscribe at any time.

Built with Kit