Interestingly, I have just completed such a form. It has 6 multiselect list
boxes and the user may select one or more items from each. Here are some
procedures I use to build a Where Condition string that I pass to the report
as the Where Condition. It could be modified to use for a query as well with
some modification, but I think this will give you the basic idea. FindWhere
is called from the after update event of a command button that display's the
list box with available options based on the previous list box's selection:
**********Calling Example***********
********Sets listbox rowsource
Private Sub cmdBillNetwork_Click()
Dim strWhere As String
DoCmd.Hourglass True
Call ResetScreen(3)
With Me.lstBillNetwork
strWhere = FindWhere(3)
If .RowSource = "" Then
.RowSource = "SELECT DISTINCT tblActivity.actvContractActivity "
& _
"FROM tblActivity RIGHT JOIN tblBudgetVSActualLbrPO ON " & _
"tblActivity.actvActivity = tblBudgetVSActualLbrPO.activity
" & _
"WHERE Len(Trim(Nz(tblActivity.actvContractActivity,''))) >
0" & _
strWhere & ";"
End If
If .ListCount = 0 Then
Me.lblBillNetwork.Caption = "No Matches"
Me.lblBillNetwork.ForeColor = 255
.Height = 0
Me.cmdPool.SetFocus
Else
.Height = 3015
.SetFocus
End If
End With
DoCmd.Hourglass False
End Sub
**********End Calling Example*******
*******Determines what to include in the string*************
Private Function FindWhere(lngSelector As Long) As String
Dim strWhere As String
If lngSelector = 1 Then
strWhere = BuildWhereCondition("lstPool")
If Len(strWhere) > 0 Then
strWhere = " AND tblBudgetVSActualLbrPO.Pool " & strWhere
End If
End If
If lngSelector <= 2 Then
If (lngSelector < 2 And strWhere = "") Or lngSelector > 1 Then
strWhere = BuildWhereCondition("lstBillNetwork")
If Len(strWhere) > 0 Then
strWhere = " AND tblActivity.actvContractActivity " & strWhere
End If
End If
End If
If lngSelector <= 3 Then
If (lngSelector < 3 And strWhere = "") Or lngSelector > 2 Then
strWhere = BuildWhereCondition("lstActivity")
If Len(strWhere) > 0 Then
strWhere = " AND tblBudgetVSActualLbrPO.activity " & strWhere
End If
End If
End If
If lngSelector <= 4 Then
If (lngSelector < 4 And strWhere = "") Or lngSelector > 3 Then
strWhere = BuildWhereCondition("lstMActivity")
If Len(strWhere) > 0 Then
strWhere = " AND tblActivity.actvParentActivity " & strWhere
End If
End If
End If
If lngSelector <= 5 Then
If (lngSelector < 5 And strWhere = "") Or lngSelector > 4 Then
strWhere = BuildWhereCondition("lstBillProdOffering")
If Len(strWhere) > 0 Then
strWhere = " AND
tblBudgetVSActualLbrPO.BillableProductOffering " & _
strWhere
End If
End If
End If
FindWhere = strWhere
End Function
********End
*******Builds the Individual Conditions based on list box selectons****
Private Function BuildWhereCondition(strControl As String) As String
'Set up the WhereCondition Argument for the reports
Dim varItem As Variant
Dim strWhere As String
Dim ctl As Control
Set ctl = Me.Controls(strControl)
Select Case ctl.ItemsSelected.Count
Case 0 'Include All
strWhere = ""
Case 1 'Only One Selected
strWhere = "= '" & _
ctl.ItemData(ctl.ItemsSelected(0)) & "'"
Case Else 'Multiple Selection
strWhere = " IN ("
With ctl
For Each varItem In .ItemsSelected
strWhere = strWhere & "'" & .ItemData(varItem) & "', "
Next varItem
End With
strWhere = Left(strWhere, Len(strWhere) - 2) & ")"
End Select
BuildWhereCondition = strWhere
End Function
********End
********Puts them all together and filters the report
Private Sub PrintReport(lngView As Long)
Dim strWhere As String 'String that will hold filtering as selected on
form
Dim strWhereNext As String 'Used to concantenate multiple field selections
Dim strDocName As String 'The Report version to open
Dim strFieldName As String 'The field name to include in the Where Condition
On Error GoTo PrintReport_Err
'Billable Product Offering
strWhere = BuildWhereCondition("lstBillProdOffering")
' strFieldName = "tblBudgetVSActualLbrPO.BillableProductOffering "
strFieldName = "tblBudgetVSActualLbrPO.BillableProductOffering "
If Len(strWhere) > 0 Then
strWhere = strFieldName & strWhere
End If
'Master Activity
strWhereNext = BuildWhereCondition("lstMActivity")
strFieldName = "tblMasterActivity.MActivity "
If Len(strWhereNext) > 0 Then
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND " & strFieldName & strWhereNext
Else
strWhere = strFieldName & strWhereNext
End If
End If
'Activity
strWhereNext = BuildWhereCondition("lstActivity")
strFieldName = "tblBudgetVSActualLbrPO.Activity "
If Len(strWhereNext) > 0 Then
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND " & strFieldName & strWhereNext
Else
strWhere = strFieldName & strWhereNext
End If
End If
'BillNetwork
strWhereNext = BuildWhereCondition("lstBillNetwork")
strFieldName = "tblActivity.actvContractActivity "
If Len(strWhereNext) > 0 Then
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND " & strFieldName & strWhereNext
Else
strWhere = strFieldName & strWhereNext
End If
End If
'Pool
strWhereNext = BuildWhereCondition("lstPool")
strFieldName = "tblBudgetVSActualLbrPO.Pool "
If Len(strWhereNext) > 0 Then
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND " & strFieldName & strWhereNext
Else
strWhere = strFieldName & strWhereNext
End If
End If
'Home Room
strWhereNext = BuildWhereCondition("lstHomeRoom")
strFieldName = "tblBudgetVSActualLbrPO.acctgunit "
If Len(strWhereNext) > 0 Then
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND " & strFieldName & strWhereNext
Else
strWhere = strFieldName & strWhereNext
End If
End If
Select Case Me.opgReportFormat
Case 1 'By Product Offering
Case 2 'By Master Activity
Case 3 'By Activity
strDocName = "rptPVAByActivityPO"
Case 4 'By By BillNetwork
Case 5 'By By Pool
Case 6 'By Home Room
strDocName = "rptBPOHomeRoom"
End Select
DoCmd.OpenReport strDocName, lngView, , strWhere
PrintReport_Exit:
Exit Sub
PrintReport_Err:
MsgBox Err.Description, vbCritical + vbOKOnly, "Error in PrintReport"
Resume PrintReport_Exit
End Sub
********End
