Have you tried my corrected code as written? If so, do you get an error and, if so, what is the value of the strCriteria variable if you debug the code?
I do have an example of two multi-select list boxes in MultiSelect.zip in my public databases folder at:
https://onedrive.live.com/?cid=44CC60D7FEA42912&id=44CC60D7FEA42912!169
Note that if you are using an earlier version of Access you might find that the colour of some form objects such as buttons shows incorrectly and you will need to amend the form design accordingly.
If you have difficulty opening the link copy its text (NB, not the link location) and paste it into your browser's address bar.
However my example works in a very different way, by referencing two unbound controls in the dialogue form as parameters by means of a couple of functions published by Microsoft. The example in the demo is that to 'Filter Report on Multiple values
from Fields, combined with AND
Where Employee Is Assigned to All Selected Projects'. The code in the dialogue form's module is:
Option Compare Database
Option Explicit
Private Sub cmdClearSelectedProjects_Click()
Dim n As Integer
With Me.lstProjects
For n = 0 To .ListCount - 1
.Selected(n) = False
Next n
End With
lstProjects_AfterUpdate
End Sub
Private Sub cmdClearSelections_Click()
Dim n As Integer
With Me.lstEmployees
For n = 0 To .ListCount - 1
.Selected(n) = False
Next n
End With
lstEmployees_AfterUpdate
End Sub
Private Sub cmdOpenReport_Click()
Dim strCriteria As String
strCriteria = "EmployeeID IN" & _
"(SELECT EmployeeID FROM qryEmployeeExtendedDlg_BOTH)"
DoCmd.OpenReport "rptEmployees", _
View:=acViewPreview, _
WhereCondition:=strCriteria
End Sub
Private Sub cmdSelectAll_Click()
Dim n As Integer
With Me.lstEmployees
For n = 0 To .ListCount - 1
.Selected(n) = True
Next n
End With
lstEmployees_AfterUpdate
End Sub
Private Sub cmdSelectAllProjects_Click()
Dim n As Integer
With Me.lstProjects
For n = 0 To .ListCount - 1
.Selected(n) = True
Next n
End With
lstProjects_AfterUpdate
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("frmOpen").Visible = True
End Sub
Private Sub lstEmployees_AfterUpdate()
Dim varItem As Variant
Dim strEmployeeIDList As String
Dim ctrl As Control
Set ctrl = Me.lstEmployees
Me.txtEmployeeIDList = Null
For Each varItem In ctrl.ItemsSelected
strEmployeeIDList = strEmployeeIDList & "," & ctrl.ItemData(varItem)
Next varItem
' remove leading comma if necessary
If strEmployeeIDList <> "" Then
strEmployeeIDList = Mid(strEmployeeIDList, 2)
End If
Me.txtEmployeeIDList = strEmployeeIDList
End Sub
Private Sub lstProjects_AfterUpdate()
Dim varItem As Variant
Dim strProjectIDList As String
Dim ctrl As Control
Set ctrl = Me.lstProjects
Me.txtProjectIDList = Null
For Each varItem In ctrl.ItemsSelected
strProjectIDList = strProjectIDList & "," & ctrl.ItemData(varItem)
Next varItem
' remove leading comma if necessary
If strProjectIDList <> "" Then
strProjectIDList = Mid(strProjectIDList, 2)
End If
Me.txtProjectIDList = strProjectIDList
End Sub
' module ends
The query referenced in the cmdOpenReport button's Click event procedure is:
SELECT Employees.EmployeeID
FROM Employees INNER JOIN ProjectEmployees
ON Employees.EmployeeID=ProjectEmployees.EmployeeID
WHERE InParam(Employees.EmployeeID,Forms!frmEmployeeExtendedDlg_BOTH!txtEmployeeIDList)
AND InParam(ProjectID,Forms!frmEmployeeExtendedDlg_BOTH!txtProjectIDList)
GROUP BY Employees.EmployeeID
HAVING COUNT(*)=Forms!frmEmployeeExtendedDlg_BOTH!lstProjects.ItemsSelected.Count;
and the functions from Microsoft called by the query are:
Function GetToken(stLn, stDelim)
Dim iDelim As Integer, stToken As String
iDelim = InStr(1, stLn, stDelim)
If (iDelim <> 0) Then
stToken = LTrim$(RTrim$(Mid$(stLn, 1, iDelim - 1)))
stLn = Mid$(stLn, iDelim + 1)
Else
stToken = LTrim$(RTrim$(Mid$(stLn, 1)))
stLn = ""
End If
GetToken = stToken
End Function
'============================================================
' The InParam() function is the heart of this article. When
' the query runs, this function causes a query parameter
' dialog box to appear so you can enter a list of values.
' The values you enter are interpreted as if you
' had entered them within the parentheses of the In() operator.
'============================================================
Function InParam(Fld, Param)
Dim stToken As String
'The following two lines are optional, making queries
'case-insensitive
Fld = UCase(Fld)
Param = UCase(Param)
If IsNull(Fld) Then Fld = ""
Do While (Len(Param) > 0)
stToken = GetToken(Param, ",")
If stToken = LTrim$(RTrim$(Fld)) Then
InParam = -1
Exit Function
Else
InParam = 0
End If
Loop
End Function
Ken Sheridan, Stafford, England
