Find As Your Type Combobox

Option Compare Database
Option Explicit

'Class Module Name: FindAsYouTypeCombo
'Purpose: Turn any combobox into a "Find As You Type" 'Combobox
'Created by: MajP
'Date: Modified 7/3/2018
'Use:To use the class, you need code similar to the 'following in a form's module.
'Also requires a reference to DAO
'Parmaters:
'  TheComboBox: Your Combobox object passed as an object
'  SearchFieldName: The name of the field to Filter as string
'  FilterFromStart: Determines if you filter a field that starts with the text or if the
'                   text appears anywhere in the record.
'
'*******Start Form Code*******************
'
'Option Compare Database
'Option Explicit
'Public faytProducts As New FindAsYouTypeCombo
'Private Sub Form_Load()
'  faytProducts.InitalizeFilterCombo Me.cmbProducts, "ProductName", False
'End Sub
'
'******* END Form Code ******************
'
'
Private WithEvents mCombo As Access.ComboBox
Private WithEvents mForm As Access.Form
Private mSearchFieldName As String

Private mRsOriginalList As DAO.Recordset
Private mFilterFromStart As Boolean
'****************** Properties *************************************************
Public Property Get FilterComboBox() As Access.ComboBox
  Set FilterComboBox = mCombo
End Property
Public Property Set FilterComboBox(TheComboBox As Access.ComboBox)
  Set mCombo = TheComboBox
End Property
Public Property Get SearchFieldName() As String
  SearchFieldName = mSearchFieldName
End Property
Public Property Let SearchFieldName(ByVal theFieldName As String)
  mSearchFieldName = theFieldName
End Property
Public Property Get FilterFromStart() As Boolean
  FilterFromStart = mFilterFromStart
End Property
Public Property Let FilterFromStart(ByVal blnFilterFromStart As Boolean)
  mFilterFromStart = blnFilterFromStart
End Property

'****************** Events *************************************************

Private Sub mCombo_Change()
  Call FilterList
End Sub
Private Sub mCombo_GotFocus()
   mCombo.Dropdown
End Sub
Private Sub mCombo_AfterUpdate()
  Call unFilterList
End Sub
Private Sub mForm_Current()
  Call unFilterList
End Sub

'****************** Methods *************************************************

Private Sub FilterList()
  On Error GoTo errLable
  Dim rsTemp As DAO.Recordset
  Dim strText As String
  Dim strFilter As String
  strText = mCombo.Text
  If mSearchFieldName = "" Then
    MsgBox "Must Supply A FieldName Property to filter list."
    Exit Sub
  End If
  strText = Replace(strText, "'", "''")
  strText = Replace(strText, "#", "[#]")
  If mFilterFromStart = True Then
    strFilter = mSearchFieldName & " like '" & strText & "*'"
  Else
    strFilter = mSearchFieldName & " like '*" & strText & "*'"
  End If
  Set rsTemp = mRsOriginalList.OpenRecordset
  rsTemp.Filter = strFilter
  Set rsTemp = rsTemp.OpenRecordset
  If rsTemp.RecordCount > 0 Then
    Set mCombo.Recordset = rsTemp
  Else
      MsgBox "No records match " & strFilter
  End If
  mCombo.Dropdown
  Exit Sub
errLable:
  If Err.Number = 3061 Then
    MsgBox "Will not Filter. Verify Field Name is Correct."
  Else
    MsgBox Err.Number & "  " & Err.Description
  End If
End Sub
Private Sub unFilterList()
  On Error GoTo errLable
  Set mCombo.Recordset = mRsOriginalList
   Exit Sub
errLable:
  If Err.Number = 3061 Then
    MsgBox "Will not Filter. Verify Field Name is Correct."
  Else
    MsgBox Err.Number & "  " & Err.Description
  End If
End Sub
'****************** Inititialize and Terminiate Methods *************************************************
Private Sub Class_Terminate()
    Set mForm = Nothing
    Set mCombo = Nothing
    Set mRsOriginalList = Nothing
End Sub
Public Sub InitalizeFilterCombo(TheComboBox As Access.ComboBox, SearchFieldName As String, Optional FilterFromStart = True)
   On Error GoTo errLabel
   If Not TheComboBox.RowSourceType = "Table/Query" Then
      MsgBox "This class will only work with a combobox that uses a Table or Query as the Rowsource"
      Exit Sub
   End If
   Set mCombo = TheComboBox
   Set mForm = TheComboBox.Parent
   mSearchFieldName = SearchFieldName
   mFilterFromStart = FilterFromStart
   mForm.OnCurrent = "[Event Procedure]"
   mCombo.OnGotFocus = "[Event Procedure]"
   mCombo.OnChange = "[Event Procedure]"
   mCombo.AfterUpdate = "[Event Procedure]"
   With mCombo
     .SetFocus
     .AutoExpand = False
   End With
   mCombo.Dropdown
   If mCombo.Recordset Is Nothing Then
     'Fix added 7/3/2018: sometimes the combos recordset is not set
     Dim rs As DAO.Recordset
     Set rs = CurrentDb.OpenRecordset(mCombo.RowSource)
     Set mCombo.Recordset = rs
   End If
   Set mRsOriginalList = mCombo.Recordset.Clone
   Exit Sub
errLabel:
    MsgBox Err.Number & " " & Err.Description
End Sub