I have a form (frmSearch
) that I use several (4) comboboxes to filter out results for a listbox (lstCustomers
). What I'm attempting to do now is create the ability to filter the listbox based on a text box of "keywords". Additionally, the column which the keyword box will search will be variable based on cboWhere
which is a list of columns from tblContacts
(the table qryContactWants
uses)
I found a really nice Function set with the following code that will let me filter everything, but I'm not entirely sure how to turn this data around and use it to filter out my listbox.
This function organizes the keywords:
Public Function FindAnyWord(varFindIn, strWordList As String) As Boolean
Dim var
Dim aWords
aWords = Split(strWordList, ",")
For Each var In aWords
If FindWord(varFindIn, var) Then
FindAnyWord = True
Exit Function
End If
Next var
End Function
And this function actually performs the search:
Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean
Const PUNCLIST = """' .,?!:;(){}[]-—/"
Dim intPos As Integer
FindWord = False
If Not IsNull(varFindIn) And Not IsNull(varWord) Then
intPos = InStr(varFindIn, varWord)
' loop until no instances of sought substring found
Do While intPos > 0
' is it at start of string
If intPos = 1 Then
' is it whole string?
If Len(varFindIn) = Len(varWord) Then
FindWord = True
Exit Function
' is it followed by a space or punctuation mark?
ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
Else
' is it precedeed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
' is it at end of string or followed by a space or punctuation mark?
If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
FindWord = True
Exit Function
End If
End If
End If
' remove characters up to end of first instance
' of sought substring before looping
varFindIn = Mid(varFindIn, intPos + 1)
intPos = InStr(varFindIn, varWord)
Loop
End If
End Function
And here is the code that I typically use to filter the listbox using the comboboxes on frmSearch
:
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub
What I would like to do is take the functions I found for searching keywords and apply it to my form and aid in returning a list of customers in lstCustomers
Ideally, having the keyword function return an SQL statement similar to those I'm using to filter out the listbox would be perfect. This would allow me to add a simple SQL = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING
EDIT 1:
While using the following code, VBA is tossing a compile error on the second "End If" stating there isn't a Block If. There clearly is, so I'm not sure what's going on. Here is the code I'm using:
Public Function KeyWhere(strKeys As String, strColumn As String) As String
Dim b As Variant
strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns
b = Split(strKeys, ",")
Dim strWhere As String
Dim v As Variant
For Each v In b
If Trim(b) <> "" Then
If strWhere <> "" Then strWhere = strWhere & " or "
strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
End If
End If
Next
strWhere = "(" & strWhere & ")"
KeyWhere = strWhere
End Function
And under the function RequerylistCustomers()
I added the If IsNull (Me.txtSearch) = False Then
code below:
Private Sub RequerylstCustomers()
Dim SQL As String
'Dim criteria As String
Dim column As String
SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _
& "FROM qryContactWants " _
& "WHERE 1=1 "
If cboType.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'"
End If
If cboMake.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'"
End If
If cboModel.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'"
End If
If cboYear.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'"
End If
If cboCondition.Value & "" <> "" Then
SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'"
End If
Dim strWhere As String
'Grab Keywords from txtSearch using cboWhere to search for those keywords
If IsNull(Me.txtSearch) = False Then
strWhere = KeyWhere(Me.txtSearch, Me.cboWhere)
SQL = SQL & " AND " & strWhere
End If
SQL = SQL & " ORDER BY qryContactWants.Last"
Me.lstCustomers.RowSource = SQL
Me.lstCustomers.Requery
End Sub