Query Criteria from multiple selection list box

[feathers212]

I have a form with list boxes and several subforms. Multiple items can be selected from each list box. Based on the selections from the list boxes, the subforms (based on one main query) display the proper filtered information.

The problem is that I need to be able to select multiple items from each list box. I have created an AfterUpdate event that creates a string value based on the selected items and stores that value in a text box on the form. The following is an example of the criteria created from values from one of the list boxes:

Private Sub CategoryList_AfterUpdate()
       
    Dim ctlSource As Control
    Dim strCatCriteria As String
    Dim intCurrentRow As Integer
    
    strCatCriteria = ""

    Set ctlSource = Me!CategoryList
    For intCurrentRow = 0 To ctlSource.ListCount - 1
        If ctlSource.Selected(intCurrentRow) Then
            If strCatCriteria = "" Then
                strCatCriteria = "'" & ctlSource.Column(0, intCurrentRow) & "'"
            Else
                strCatCriteria = strCatCriteria & " Or '" & ctlSource.Column(0, intCurrentRow) & "'"
            End If
        Else: End If
    Next intCurrentRow
    
    CatParam.Value = strCatCriteria

Exit Sub

So if Category 1, Category 2, and Category 5 are selected from the CategoryList list box, the CatParam text box shows: 'Category 1' Or 'Category 2' Or 'Category 5'
This works just fine.

I then have the main query (which then drives the information for the subforms) pulling its criteria fields from the main form using the following: [Forms]![Main Form]![CatParam]
This is where things don't work. If I manually enter the 'Category 1' Or 'Category 2' Or 'Category 5' into the query criteria, everything works. But referencing the form's text box does nothing. The query results in no records displayed.

Any thoughts, ideas, suggestions??

 

[WayneRyan]

Feathers,

The problem is that the underlying SQL doesn't mean what you
think it should.

Example 1:

Criteria--> =0 or 1 or 2

The underlying SQL is translated to:

SELECT tblHrsWkd.RecID, tblHrsWkd.EmpID, tblHrsWkd.DateWorked
FROM tblHrsWkd
WHERE ((([B]tblHrsWkd.EmpID[/B])=0 Or ([B]tblHrsWkd.EmpID[/B])=1 Or ([B]tblHrsWkd.EmpID[/B])=2));

Example 2:

Criteria --> =Forms![frmMain]![Criteria]

SELECT tblHrsWkd.RecID, tblHrsWkd.EmpID, tblHrsWkd.DateWorked
FROM tblHrsWkd
WHERE [B](((tblHrsWkd.EmpID)=[forms]![frmMain]![criteria]));[/B]

In the first example, the underlying query paired the field with each possibility
even though it doesn't look like it in the grid.

In the second example, the underlying query simply states that the field had
to be equal to the textbox on the form (NOT the textbox's "intent").

To employ this method, you'll have to "write" the SQL based on your listbox
selections.

Select ...  <-- Static
From   ...  <-- Static
Where  SomeField In ('a', 'b', 'c' ...) <-- Constructed similar to your example
Order By ...  <-- Static

Then, you can use the QueryDef object to alter your query.

Search here for "QueryDef".

I know this is a popular topic for listboxes feeding Report queries.

hth,
Wayne

 

[kidrobot]

Private Sub cmdOpenQuery_Click()

On Error GoTo Err_cmdOpenQuery_Click
    
    Dim MyDB As DAO.Database
    Dim qdef As DAO.QueryDef
    Dim i As Integer
    Dim strSQL As String
    Dim strWhere As String
    Dim strIN As String
    Dim flgSelectAll As Boolean
    Dim varItem As Variant

    Set MyDB = CurrentDb()
    
    strSQL = "SELECT * FROM qry2Final"

    'Build the IN string by looping through the listbox
    For i = 0 To lstTrains.ListCount - 1
        If lstTrains.Selected(i) Then
            If lstTrains.Column(0, i) = "All" Then
                flgSelectAll = True
            End If
            strIN = strIN & "'" & lstTrains.Column(0, i) & "',"
        End If
    Next i

    'Create the WHERE string, and strip off the last comma of the IN string
    strWhere = " WHERE [Trn] in " & _
               "(" & Left(strIN, Len(strIN) - 1) & ")"

    'If "All" was selected in the listbox, don't add the WHERE condition
    If Not flgSelectAll Then
        strSQL = strSQL & strWhere
    End If

    CurrentDb.QueryDefs.Delete "Temp"
    Set qdef = CurrentDb.CreateQueryDef("Temp", strSQL)

    'Open the query, built using the IN clause to set the criteria
    DoCmd.OpenQuery "Temp", acViewNormal
    'DoCmd.OpenReport "qry2Final", acViewPreview
    'Clear listbox selection after running query
    For Each varItem In Me.lstTrains.ItemsSelected
        Me.lstTrains.Selected(varItem) = False
    Next varItem


Exit_cmdOpenQuery_Click:
    Exit Sub

Err_cmdOpenQuery_Click:

    If Err.Number = 5 Then
       MsgBox "You must make a selection(s) from the list" _
             , , "Selection Required !"
     Resume Exit_cmdOpenQuery_Click
     Else
         'Write out the error and exit the sub
        MsgBox Err.Description
        Resume Exit_cmdOpenQuery_Click
    End If

End Sub

 

[feathers212]

Thanks to kidrobot for sharing code created in a similar problem. The following code creates a query who's criteria is based on multiple selections from multiple listboxes on a form.

Sub CreateAllForms()

    Dim ctlSource As Control
    Dim i As Variant
    Dim intFilterFlag As Integer
    Dim strCatParam As String
    Dim strCCParam As String
    Dim strStatusParam As String
    Dim strWhereClause As String
    Dim strSQL As String
    
    'Select Contents from Category Listbox
    Set ctlSource = Me!CategoryList
    
    strCatParam = ""
    intFilterFlag = 1
    
    For Each i In ctlSource.ItemsSelected
        strCatParam = strCatParam & ctlSource.ItemData(i) & "','"
    Next i
    
    If Len(strCatParam) > 0 Then
        strCatParam = Left(strCatParam, Len(strCatParam) - 3)
        intFilterFlag = intFilterFlag + 1
    End If
    
    'Define Filter/Where requirements for Recordset
    Select Case intFilterFlag
        Case Is = 1
            strWhereClause = ""
        Case Is = 2
            strWhereClause = "([Short Names].Category) In ('" & strCatParam & "')"
    End Select
     
    'Select Contents from Status Listbox
    Set ctlSource = Me!StatusList
    
    strStatusParam = ""
    intFilterFlag = 1
    
    For Each i In ctlSource.ItemsSelected
        strStatusParam = strStatusParam & ctlSource.ItemData(i) & "','"
    Next i
    
    If Len(strStatusParam) > 0 Then
        strStatusParam = Left(strStatusParam, Len(strStatusParam) - 3)
        intFilterFlag = intFilterFlag + 1
    End If
    
    'Define Filter/Where requirements for Recordset
    Select Case intFilterFlag
        Case Is = 1
            strWhereClause = strWhereClause
        Case Is = 2
            If strWhereClause = "" Then
                strWhereClause = "([Short Names].Status) In ('" & strStatusParam & "')"
            Else
                strWhereClause = strWhereClause & " AND ([Short Names].Status) In ('" & strStatusParam & "')"
            End If
    End Select
    
    'Select Contents from Cost Center Listbox
    Set ctlSource = Me!CostCenterList
    
    strCCParam = ""
    intFilterFlag = 1
    
    For Each i In ctlSource.ItemsSelected
        strCCParam = strCCParam & ctlSource.ItemData(i) & "','"
    Next i
    
    If Len(strCCParam) > 0 Then
        strCCParam = Left(strCCParam, Len(strCCParam) - 3)
        intFilterFlag = intFilterFlag + 1
    End If
    
    'Define Filter/Where requirements for Recordset
    Select Case intFilterFlag
        Case Is = 1
            strWhereClause = strWhereClause
        Case Is = 2
                If strWhereClause = "" Then
                strWhereClause = "(Presses.Press) In ('" & strCCParam & "')"
            Else
                strWhereClause = strWhereClause & " AND (Presses.Press) In ('" & strCCParam & "')"
            End If
    End Select
    
    If strWhereClause = "" Then
    Else
        strWhereClause = " WHERE (" & strWhereClause & ")"
    End If
    
    strSQL = "SELECT DISTINCTROW [Short Names].Category, [Short Names].[Short Name] AS Material, Presses.Press, [Pressroom SAP Data].Reference AS Employee, [Pressroom SAP Data].[Pstg date] AS [Date], [Quantity in UnE]*-1 AS Quantity, [Pressroom SAP Data].EUn AS Unit, [Field12]*-1 AS Cost, [Short Names].Status FROM Presses INNER JOIN ([Short Names] INNER JOIN [Pressroom SAP Data] ON [Short Names].[SAP Name] = [Pressroom SAP Data].[Material description]) ON Presses.[Cost Center] = [Pressroom SAP Data].[Cost ctr]" & strWhereClause & ";"
    
    Dim qdfTemp As QueryDef
    CurrentDb.QueryDefs.Delete "Short Names Query"
    Set qdfTemp = CurrentDb.CreateQueryDef("Short Names Query", strSQL)

End Sub

 

[WayneRyan]

Nice Job Kid!

Wayne