Solved Search across multiple fields

[Harry Paraskeva]

Hello to all,

I have a form in an MS Access 64-bit frontend with some text fields, some integer, and some combo boxes (the backend is in MySQL). The combo boxes have queries in their row source that are bound to the form based on ID, but contain text data in the second column of the row source query. I provide an example row source query of one of the combo boxes below:

SELECT dating.ID, dating.Period_Name AS Period, dating.General, dating.Order FROM dating AS dating WHERE (((dating.General)=Yes)) ORDER BY dating.ID, dating.Order;

It should be noted that the first/bound column of the combo boxes is hidden (0-width column), so as to show the second column with the text.

I also have an unbound text box and a button. The latter two are meant to allow the end user to type a string in the text box and when the user clicks the button VBA code should be doing the following:
- Looking if the string is contained in a selection of the text and integer fields.
- Looking if the string is contained in the second column of the row source query in combo boxes.
- Changing the form's row source and repopulating it only with fields matching the search criteria.
The decision to go with row source change, instead of filtering has to do with the fact that the form is quite complex (about 150 fields and 7 nested subforms).

I have produced this code, but it doesn't work and I'm not sure why.

Private Sub cmdSearch_Click()
    Dim strSearch As String
    Dim rstClone As Recordset
    Dim strFilter As String

    If Me.Search_Descriptions = "" Or IsNull(Me.Search_Descriptions) Then
        MsgBox "Please add a search term in the search box.", vbOKOnly, "No search term"
        Exit Sub
    End If

    strSearch = Me.Search_Descriptions.Value

    ' Clone the recordset of the form "Inventory_List"
    Set rstClone = Me.RecordsetClone

    ' Build the base filter string
    strFilter = "[Inventory_Provenance] Like '*" & strSearch & "*' OR [Context] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Exact_Dating] Like '*" & strSearch & "*' OR [Artefact_Type] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Materials] Like '*" & strSearch & "*' OR [Description] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Artefact_Caption] Like '*" & strSearch & "*'"

    ' Handle Specific_Dating_List combo box
    If Me.Specific_Dating_List.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [Specific_Dating_List] = " & Me.Specific_Dating_List.Value
    End If

    ' Handle General_Dating_List combo box
    If Me.General_Dating_List.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [General_Dating_List] = " & Me.General_Dating_List.Value
    End If

    ' Handle General_Category combo box
    If Me.General_Category.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [General_Category] = " & Me.General_Category.Value
    End If

    ' Apply the filter to the cloned recordset
    rstClone.Filter = strFilter

    ' Populate the form's record source with the filtered records
    If rstClone.RecordCount > 0 Then
        Set Me.Recordset = rstClone
        Me.Requery
    Else
        MsgBox "No records found.", vbOKOnly, "Search Results"
        ' Clear the form's record source if no records are found
        Me.RecordSource = ""
    End If

    ' Clear the search box
    Me.Search_Descriptions.Value = ""

    ' Cleanup
    Set rstClone = Nothing
End Sub

 

[Pat Hartman]

I can't figure out if you are trying to filter the RowSource of the combo or the form itself. If you are trying to filter the combo, your filter string should be used to alter the RowSource of the combo, not the RecordsetClone of the RecordSource for the form.

If you have "groups" of items in the combo, a better technique would be to add a group to the table underlying the combo's RowSource. Then you can use cascading combos to filter the RowSource which should be more efficient.

Don't use a bound control for searching.

 

[Harry Paraskeva]

I can't figure out if you are trying to filter the RowSource of the combo or the form itself. If you are trying to filter the combo, your filter string should be used to alter the RowSource of the combo, not the RecordsetClone of the RecordSource for the form.

If you have "groups" of items in the combo, a better technique would be to add a group to the table underlying the combo's RowSource. Then you can use cascading combos to filter the RowSource which should be more efficient.

Don't use a bound control for searching.

Thank you for the comment. In regard to the questions:
- I am filtering a clone of the currently displayed Recordset of the form to get only records that have a certain value contained in select fields. Note that the form currently has about 7500 records [e.g. if a user searches for the term "bronze", it should return records that have the term in the text box Material (e.g. bronze alloy) or the text box Artefact Type (e.g. bronze dagger) or the combo box Specific Dating (e.g. Early Bronze Age <-- this is in .Column(1) of the combo box) or the text box Description (e.g. Bronze statue of the emperor Caesar].
- I already have both single and cascarding combo boxes that filter the RowSource. What I'm developing is a separate free text search mechanism that filters the RowSource of the form based on the search term.
- I am using an unbound text box for searching.

PS: I am filtering the Recordset clone because the user may have already applied other filters.

 

[GaP42]

What I'm developing is a separate free text search mechanism that filters the RowSource of the form based on the search term.

There are any number of solutions to free text search that may be adopted/adapted -
@MajP has posted a FAYT - for text search, combo, listbox, ..
https://www.access-programmers.co.u...o-code-from-majp-question.319205/post-1781383
Another I have used from OpenGate software:
https://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html

 

[arnelgp]

you can try Saving the Original recordsource of your form
on the Form's Load Event:

' Edited to add this
Dim m_source As String


Private Sub Form_Load()
m_source = Replace$(Me.RecordSource, ";", "")
End Sub

then you can change your code to:

Private Sub cmdSearch_Click()
    Dim strSearch As String
    Dim rstClone As Recordset
    Dim strFilter As String

    If Me.Search_Descriptions = "" Or IsNull(Me.Search_Descriptions) Then
        MsgBox "Please add a search term in the search box.", vbOKOnly, "No search term"
        Exit Sub
    End If

    strSearch = Me.Search_Descriptions.Value

    ' Clone the recordset of the form "Inventory_List"
    'Set rstClone = Me.RecordsetClone

    ' Build the base filter string
    strFilter = "[Inventory_Provenance] Like '*" & strSearch & "*' OR [Context] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Exact_Dating] Like '*" & strSearch & "*' OR [Artefact_Type] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Materials] Like '*" & strSearch & "*' OR [Description] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Artefact_Caption] Like '*" & strSearch & "*'"

    ' Handle Specific_Dating_List combo box
    If Me.Specific_Dating_List.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [Specific_Dating_List] = " & Me.Specific_Dating_List.Value
    End If

    ' Handle General_Dating_List combo box
    If Me.General_Dating_List.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [General_Dating_List] = " & Me.General_Dating_List.Value
    End If

    ' Handle General_Category combo box
    If Me.General_Category.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [General_Category] = " & Me.General_Category.Value
    End If

    ' Apply the filter to the cloned recordset
    'rstClone.Filter = strFilter

    ' Populate the form's record source with the filtered records
    'If rstClone.RecordCount > 0 Then
    '    Set Me.Recordset = rstClone
    '    Me.Requery
    'Else
    '    MsgBox "No records found.", vbOKOnly, "Search Results"
    '    ' Clear the form's record source if no records are found
    '    Me.RecordSource = ""
    'End If
 
    'arnelgp
    'open a recordset
    Dim sql As String
    If InStr(1, m_source, "SELECT") <> 0 Then
        sql = "SELECT * FROM (" & m_source & ") WHERE " & strFilter
    Else
        sql = "SELECT * FROM " & m_source & " WHERE " & strFilter
    End If
    With CurrentDb.OpenRecordset(sql, dbOpenSnapshot, dbReadOnly)
        If Not (.BOF And .EOF) Then
            Me.RecordSource= sql
        Else
            MsgBox "No records found.", vbOKOnly, "Search Results"
            If Me.RecordSource <> m_source Then
                   Me.RecordSource = m_source
            End If
        End If
        .Close
    End With
     

    ' Clear the search box
    Me.Search_Descriptions.Value = ""

    ' Cleanup
    'Set rstClone = Nothing
End Sub

 

[Harry Paraskeva]

There are any number of solutions to free text search that may be adopted/adapted -
MajP has posted a FAYT - for text search, combo, listbox
Another I have used from OpenGate software

Thank you for the links. I will take a closer look at FAYT's classes, as they may contain some interesting ideas to adopt/adapt. Generally, I don't really need a search as you type, more of a type and filter the current recordsource of the form to display records with the term contained in a number of fields. Also, I don't want to load in a single combo box information from 8 fields that contain in total more than 8 million characters, as that could stress system resources.

 

[Harry Paraskeva]

you can try Saving the Original recordsource of your form
on the Form's Load Event:

Private Sub Form_Load()
m_source = Replace$(Me.RecordSource, ";", "")
End Sub

then you can change your code to:

Private Sub cmdSearch_Click()
    Dim strSearch As String
    Dim rstClone As Recordset
    Dim strFilter As String

    If Me.Search_Descriptions = "" Or IsNull(Me.Search_Descriptions) Then
        MsgBox "Please add a search term in the search box.", vbOKOnly, "No search term"
        Exit Sub
    End If

    strSearch = Me.Search_Descriptions.Value

    ' Clone the recordset of the form "Inventory_List"
    'Set rstClone = Me.RecordsetClone

    ' Build the base filter string
    strFilter = "[Inventory_Provenance] Like '*" & strSearch & "*' OR [Context] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Exact_Dating] Like '*" & strSearch & "*' OR [Artefact_Type] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Materials] Like '*" & strSearch & "*' OR [Description] Like '*" & strSearch & "*'"
    strFilter = strFilter & " OR [Artefact_Caption] Like '*" & strSearch & "*'"

    ' Handle Specific_Dating_List combo box
    If Me.Specific_Dating_List.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [Specific_Dating_List] = " & Me.Specific_Dating_List.Value
    End If

    ' Handle General_Dating_List combo box
    If Me.General_Dating_List.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [General_Dating_List] = " & Me.General_Dating_List.Value
    End If

    ' Handle General_Category combo box
    If Me.General_Category.Column(1) Like "*" & strSearch & "*" Then
        strFilter = strFilter & " OR [General_Category] = " & Me.General_Category.Value
    End If

    ' Apply the filter to the cloned recordset
    'rstClone.Filter = strFilter

    ' Populate the form's record source with the filtered records
    'If rstClone.RecordCount > 0 Then
    '    Set Me.Recordset = rstClone
    '    Me.Requery
    'Else
    '    MsgBox "No records found.", vbOKOnly, "Search Results"
    '    ' Clear the form's record source if no records are found
    '    Me.RecordSource = ""
    'End If
 
    'arnelgp
    'open a recordset
    Dim sql As String
    If InStr(1, m_source, "SELECT") <> 0 Then
        sql = "SELECT * FROM (" & m_source & ") WHERE " & strFilter
    Else
        sql = "SELECT * FROM " & m_source & " WHERE " & strFilter
    End If
    With CurrentDb.OpenRecordset(sql, dbOpenSnapshot, dbReadOnly)
        If Not (.BOF And .EOF) Then
            Me.RecordSource= sql
        Else
            MsgBox "No records found.", vbOKOnly, "Search Results"
            If Me.RecordSource <> m_source Then
                   Me.RecordSource = m_source
            End If
        End If
        .Close
    End With
     

    ' Clear the search box
    Me.Search_Descriptions.Value = ""

    ' Cleanup
    'Set rstClone = Nothing
End Sub

Thank you for the idea and code. I will try this and report on results.

 

[GaP42]

I don't want to load in a single combo box information from 8 fields that contain in total more than 8 million characters, as that could stress system resources.

Both of the suggestions can be used to support a search from a text box across multiple fields. IIRC they also have a sensitivity that can be set to only begin searching after a specified number of characters have been entered. The MajP solution I think is up to v19 btw - not v15 as I linked.

 

[Harry Paraskeva]

Got this one to work as well...quite a tricky one in the end, but couldn't find a more elegant solution. I ended up creating arrays of values for the bound IDs of the combo fields prior to designing the SQL string for filtering the record source. If someone finds a more elegant solution, I'd be open to it. The code follows:

Dim searchTerm As String
Dim baseSQL As String
Dim SpecificDatingTerm As Integer
Dim GeneralDatingTerm As Integer
Dim GeneralCategoryTerm As Integer

If IsNull(searchTerm) Or searchTerm = "" Then
MsgBox "Please enter a search term in the search box.", vbInformation, "No search term"
Exit Sub
End If

searchTerm = Me.Search_Descriptions.Value

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim searchTermGeneralDating As String
Dim results() As Long
Dim resultCount As Integer

searchTermGeneralDating = Me.Search_Descriptions.Value
resultCount = 0

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT ID, Period_Name, General FROM dating WHERE Period_Name LIKE '*" & searchTermGeneralDating & "*' AND General = True")

If Not rs.EOF Then
    rs.MoveLast
    rs.MoveFirst
    ReDim results(0 To rs.RecordCount - 1)
    
    Do While Not rs.EOF
        results(resultCount) = rs!ID
        resultCount = resultCount + 1
        rs.MoveNext
    Loop
End If

rs.Close
Set rs = Nothing
Set db = Nothing

Dim i As Integer
'If resultCount > 0 Then
'For i = LBound(results) To UBound(results)
'    Debug.Print results(i)
'Next i
'Else
'Debug.Print "No records found."
'End If

Dim db2 As DAO.Database
Dim rs2 As DAO.Recordset
Dim searchTermSpecificDating As String
Dim results2() As Long
Dim resultCount2 As Integer

searchTermSpecificDating = Me.Search_Descriptions.Value
resultCount2 = 0

Set db2 = CurrentDb
Set rs2 = db2.OpenRecordset("SELECT ID, Period_Name, Specific FROM dating WHERE Period_Name LIKE '*" & searchTermSpecificDating & "*' AND Specific = True")

If Not rs2.EOF Then
    rs2.MoveLast
    rs2.MoveFirst
    ReDim results2(0 To rs2.RecordCount - 1)
    
    Do While Not rs2.EOF
        results2(resultCount2) = rs2!ID
        resultCount2 = resultCount2 + 1
        rs2.MoveNext
    Loop
End If

rs2.Close
Set rs2 = Nothing
Set db2 = Nothing

Dim i2 As Integer
'If resultCount2 > 0 Then
'For i2 = LBound(results2) To UBound(results2)
'    Debug.Print results2(i2)
'Next i2
'Else
'Debug.Print "No records found."
'End If

Dim db3 As DAO.Database
Dim rs3 As DAO.Recordset
Dim searchTermGeneralCategory As String
Dim results3() As Long
Dim resultCount3 As Integer

searchTermGeneralCategory = Me.Search_Descriptions.Value
resultCount3 = 0

Set db3 = CurrentDb
Set rs3 = db3.OpenRecordset("SELECT ID, Category FROM artefact_categories WHERE Category LIKE '*" & searchTermGeneralCategory & "*'")

If Not rs3.EOF Then
    rs3.MoveLast
    rs3.MoveFirst
    ReDim results3(0 To rs3.RecordCount - 1)
    
    Do While Not rs3.EOF
        results3(resultCount3) = rs3!ID
        resultCount3 = resultCount3 + 1
        rs3.MoveNext
    Loop
End If

rs3.Close
Set rs3 = Nothing
Set db3 = Nothing

Dim i3 As Integer
'If resultCount3 > 0 Then
'For i3 = LBound(results3) To UBound(results3)
'    Debug.Print results3(i3)
'Next i3
'Else
'Debug.Print "No records found."
'End If

Call Reset_Filters_Click

baseSQL = "SELECT * FROM Inventory WHERE [Inventory_Provenance] Like '*" & searchTerm & "*'"
baseSQL = baseSQL & " OR [Context] Like '*" & searchTerm & "*'"
baseSQL = baseSQL & " OR [Exact_Dating] Like '*" & searchTerm & "*'"
baseSQL = baseSQL & " OR [Artefact_Type] Like '*" & searchTerm & "*'"
baseSQL = baseSQL & " OR [Materials] Like '*" & searchTerm & "*'"
baseSQL = baseSQL & " OR [Description] Like '*" & searchTerm & "*'"
baseSQL = baseSQL & " OR [Artefact_Caption] Like '*" & searchTerm & "*'"
Dim tempSQL As String
tempSQL = ""
If resultCount > 0 Then
    tempSQL = " OR [General_Dating_List] IN ("
    For i = LBound(results) To UBound(results)
        tempSQL = tempSQL & results(i) & ", "
    Next i
    tempSQL = Left(tempSQL, Len(tempSQL) - 2) & ")"
    baseSQL = baseSQL & tempSQL
End If
tempSQL = ""
If resultCount2 > 0 Then
    tempSQL = " OR [Specific_Dating_List] IN ("
    For i2 = LBound(results2) To UBound(results2)
        tempSQL = tempSQL & results2(i2) & ", "
    Next i2
    tempSQL = Left(tempSQL, Len(tempSQL) - 2) & ")"
    baseSQL = baseSQL & tempSQL
End If
tempSQL = ""
If resultCount3 > 0 Then
    tempSQL = " OR [General_Category] IN ("
    For i3 = LBound(results3) To UBound(results3)
        tempSQL = tempSQL & results3(i3) & ", "
    Next i3
    tempSQL = Left(tempSQL, Len(tempSQL) - 2) & ")"
    baseSQL = baseSQL & tempSQL
End If

'Debug.Print baseSQL

Me.RecordSource = baseSQL
Me.Requery
Me.Search_Identifiers.Value = ""

If Me.RecordsetClone.RecordCount = 0 Then
    MsgBox "No records found. The form will reset.", vbInformation, "Search results"
    Me.RecordSource = "SELECT inventory.*, mo.Compound_Title, am.Compound_Title, se.Compound_Title, inventory.New_MO FROM se RIGHT JOIN (am RIGHT JOIN (mo RIGHT JOIN inventory ON mo.ID = inventory.New_MO) ON am.ID = inventory.New_AM) ON se.ID = inventory.New_SE ORDER BY SIN;"
    Me.Search_Identifiers.Value = ""
    Exit Sub
End If