Solved: Query by Form Multi-Select List Box?

[itipu]

I have database with a query by form which is all nice and working. (Sample attached)...

Now on the Main Form I have a field "Enter Title" but I am looking somehow to be able to select multiple values, so not only Manager, but say Manager and Officer and Senior Officer.. I was thinking of a Multi-Select List box but everything I tried failed...

The other little issue is I can't seem to get Date Range selection working..

Would appreciate your help greatly!

Thanks, Mike

In Rev2 attachment I managed to get listbox to work but it wouldn't allow to filter on both listbox and drop down boxes at the same time, is there any way around that?

[OBP]

You are resetting the Form's Record Source rather than just setting the Form's Filter, which is easier.
See this thread
http://forums.techguy.org/business-applications/857843-solved-query-form-using-list.html
and this one for a QueryDef version
http://forums.techguy.org/business-applications/868168-what-method-take-criteria-search.html

[itipu]

Thanks OPB,

Afraid I am little "green" when it comes to Access, as I was mainly doing VBA in Excel before.

I am assuming you are refeing to this section which sets RecordSource from my original query to SQLStr, but how would I set the filrer to SQLStr?

Set SF = Me.SubformBasedOnQuery
Debug.Print SQLStr
SF.Controls.Parent.RecordSource = SQLStr

I checked the links you provded, and it seems the syntax used was

DoCmd.OpenForm "frmCriteriaSearchResults", , , WhereCondition:=strWhere

where strWhere is equivalent of my SQLStr... Sorry I am afraid I am bit lost here so perhaps you could be a little more specific... Really appreciate it!

Mike

[OBP]

Mike, I would post a copy of the database, but my posting attachment limit has been reached apparently.
The Filter Version looks like this (not my code)

'Filter a Form by setting the Form Filter using VBA.

Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria string to append to.

'***********************************************************************
'Look at each search box, and build up the criteria string from the non-blank ones.
'***********************************************************************
'Text field example. Use quotes around the value in the string.
If Not IsNull(Me.txtFilterCity) Then
strWhere = strWhere & "([City] = """ & Me.txtFilterCity & """) AND "
End If

'Another text field example. Use Like to find anywhere in the field.
If Not IsNull(Me.txtFilterMainName) Then
strWhere = strWhere & "([MainName] Like ""*" & Me.txtFilterMainName & "*"") AND "
End If

'Number field example. Do not add the extra quotes.
If Not IsNull(Me.cboFilterLevel) Then
strWhere = strWhere & "([LevelID] = " & Me.cboFilterLevel & ") AND "
End If

'Yes/No field and combo example. If combo is blank or contains "ALL", we do nothing.
If Me.cboFilterIsCorporate = -1 Then
strWhere = strWhere & "([IsCorporate] = True) AND "
ElseIf Me.cboFilterIsCorporate = 0 Then
strWhere = strWhere & "([IsCorporate] = False) AND "
End If

'Date field example. Use the format string to add the # delimiters and get the right international format.
If Not IsNull(Me.txtStartDate) Then
strWhere = strWhere & "([EnteredOn] >= " & Format(Me.txtStartDate, conJetDate) & ") AND "
End If

'Another date field example. Use "less than the next day" since this field has times as well as dates.
If Not IsNull(Me.txtEndDate) Then 'Less than the next day.
strWhere = strWhere & "([EnteredOn] < " & Format(Me.txtEndDate + 1, conJetDate) & ") AND "
End If

'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's Filter.
'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ") to remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the " AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line. Prints to Immediate Window (Ctrl+G).
'Debug.Print strWhere

'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If


This one is my code for using multi list boxes.

Multi List Boxes for Searching
Public Sub createFilter()
Dim strType As String
Dim strCritical As String
Dim strScope As String
Dim strRRB1 As String
Dim strRRB2 As String
Dim strArea As String
Dim strKPP
Dim strFilter As String
Dim itm As Variant

'Filter by Type
For Each itm In Me.lstFilterByType.ItemsSelected
If strType = "" Then
strType = "strRequirementType_Threshold_Objective = '" & Me.lstFilterByType.ItemData(itm) & "'"
Else
strType = strType & " OR strRequirementType_Threshold_Objective = '" & Me.lstFilterByType.ItemData(itm) & "'"
End If
Next itm
If Not strType = "" Then
strType = " (" & strType & ") AND "
End If

'Filter by Critical
For Each itm In Me.lstFilterByCritical.ItemsSelected
If strCritical = "" Then
strCritical = "blnCriticalRequirement = " & Me.lstFilterByCritical.ItemData(itm)
Else
strCritical = strCritical & " OR blnCriticalRequirement = " & Me.lstFilterByCritical.ItemData(itm)
End If
Next itm
If Not strCritical = "" Then
strCritical = "(" & strCritical & ") AND "
End If

'Filter by scope
For Each itm In Me.lstFilterByScope.ItemsSelected
If strScope = "" Then
strScope = "inScope = " & Me.lstFilterByScope.ItemData(itm)
Else
strScope = strScope & " OR inScope = " & Me.lstFilterByScope.ItemData(itm)
End If
Next itm
If Not strScope = "" Then
strScope = " (" & strScope & ") AND "
End If

'Filter by RRB1 resolution
For Each itm In Me.lstRRB1.ItemsSelected
If strRRB1 = "" Then
strRRB1 = "strResults = '" & Me.lstRRB1.ItemData(itm) & "'"
Else
strRRB1 = strRRB1 & " OR strResults = '" & Me.lstRRB1.ItemData(itm) & "'"
End If
Next itm
If Not strRRB1 = "" Then
strRRB1 = " (" & strRRB1 & ") AND "
End If

'Filter by RRB2 Resolution
For Each itm In Me.lstRRB2.ItemsSelected
If strRRB2 = "" Then
strRRB2 = "strRRB2Results = '" & Me.lstRRB2.ItemData(itm) & "'"
Else
strRRB2 = strRRB2 & " OR strRRB2Results = '" & Me.lstRRB2.ItemData(itm) & "'"
End If
Next itm
If Not strRRB2 = "" Then
strRRB2 = " (" & strRRB2 & ") AND "
End If

'Filter by KPP
For Each itm In Me.lstFilterByKPP.ItemsSelected
If strKPP = "" Then
strKPP = "isKPP = " & Me.lstFilterByKPP.ItemData(itm)
Else
strKPP = strKPP & " OR isKPP = " & Me.lstFilterByKPP.ItemData(itm)
End If
Next itm
If Not strKPP = "" Then
strKPP = "(" & strKPP & ") AND "
End If

'Filter by Area
For Each itm In Me.lstFilterByArea.ItemsSelected
If strArea = "" Then
strArea = "strFunctionalArea = '" & Me.lstFilterByArea.ItemData(itm) & "'"
Else
strArea = strArea & " OR strFunctionalArea = '" & Me.lstFilterByArea.ItemData(itm) & "'"
End If
Next itm
If Not strArea = "" Then
strArea = " (" & strArea & ") AND "
End If

strFilter = strType & strCritical & strScope & strRRB1 & strRRB2 & strKPP & strArea
If Not strFilter = "" Then
strFilter = Left(strFilter, Len(strFilter) - 5)
End If
'Debug.Print strFilter


Me.FilterOn = False
Me.Filter = ""
Me.Filter = strFilter
Me.FilterOn = True
If Me.Recordset.RecordCount = 0 Then
Me.FilterOn = False
MsgBox "No Records"
End If
End Sub