VBA Code for Access Query based on 2 List Boxes

Question

Hi All,

Embarrassing newbie here, learning as I go.  I was on here last week asking about Nulls and Combo boxes, and all advice worked wonderfully.  Now my boss would like it if there were a multi-select option on our form.  I can create an on-click for just one listbox, no problem... however, more than that and I am unsure how to proceed.

Below is the code I am using. 

Private Sub Okay_2_Click()

 Dim Q As QueryDef, DB As Database

   Dim Criteria As String

   Dim ctl As Control

   Dim Itm As Variant

   ' Build a list of the selections.

   Set ctl = Me![LstSubject]

   For Each Itm In ctl.ItemsSelected

      If Len(Criteria) = 0 Then

         Criteria = Chr(34) & ctl.ItemData(Itm) & Chr(34)

      Else

         Criteria = Criteria & "," & Chr(34) & ctl.ItemData(Itm) _

          & Chr(34)

      End If

   Next Itm

   If Len(Criteria) = 0 Then

      Itm = MsgBox("You must select one or more items in the" & _

        " list box!", 0, "No Selection Made")

      Exit Sub

   End If

   ' Modify the Query.

   Set DB = CurrentDb()

   Set Q = DB.QueryDefs("MultiSelect")

   Q.SQL = "Select * From BabyData Where [Subject] In(" & Criteria & _

     ");"

   Q.Close

   ' Run the query.

   DoCmd.OpenQuery "MultiSelect"

End Sub

As I said, this works great for just one list box.  I want to adapt this so I can also select criteria from another list box as well.  My modifications look like the below, and are woefully unsuccessful.

Private Sub Okay_2_Click()

 Dim Q As QueryDef, DB As Database

   Dim Criteria As String

   Dim Crit As String

   Dim ctl As Control

   Dim ctl2 As Control

   Dim Itm As Variant

   ' Build a list of the selections.

   Set ctl = Me![LstSubject]

   For Each Itm In ctl.ItemsSelected

      If Len(Criteria) = 0 Then

         Criteria = Chr(34) & ctl.ItemData(Itm) & Chr(34)

      Else

         Criteria = Criteria & "," & Chr(34) & ctl.ItemData(Itm) _

          & Chr(34)

      End If

   Next Itm

   If Len(Criteria) = 0 Then

      Itm = MsgBox("You must select one or more items in the" & _

        " list box!", 0, "No Selection Made")

      Exit Sub

   End If

   ' Build a list of the selections.

   Set ctl2 = Me![LstCategory]

   For Each Itm In ctl2.ItemsSelected

      If Len(Crit) = 0 Then

         Crit = Chr(34) & ctl2.ItemData(Itm) & Chr(34)

      Else

         Criteria = Crit & "," & Chr(34) & ctl2.ItemData(Itm) _

          & Chr(34)

      End If

   Next Itm

   If Len(Crit) = 0 Then

      Itm = MsgBox("You must select one or more items in the" & _

        " list box!", 0, "No Selection Made")

      Exit Sub

   End If

   ' Modify the Query.

   Set DB = CurrentDb()

   Set Q = DB.QueryDefs("MultiSelect")

   Q.SQL = "Select * From BabyData Where [Subject] In(" & Criteria & _

     ") And [Category] In (" & Criteria & _

     ");"

   Q.Close

   ' Run the query.

   DoCmd.OpenQuery "MultiSelect"

End Sub

If someone could tell me what I am missing, I'd be much obliged.

Answer 1

You're mixing up your criteria variables, here and there.  Try this version:

'------ start of code ------

Private Sub Okay_2_Click()

    Dim DB As Database

    Dim Q As QueryDef

    Dim strSubjCriteria As String

    Dim strCatCriteria As String

    Dim Itm As Variant

   ' Build a list of the Subject selections.

    With Me!LstSubject

        For Each Itm In .ItemsSelected

            strSubjCriteria = strSubjCriteria & "," & Chr(34) & .ItemData(Itm) & Chr(34)

        Next Itm

    End With

    If Len(strSubjCriteria) = 0 Then

        MsgBox _

            "You must select one or more items in the list box!", _

            vbExclamation, _

            "No Selection Made"

        Me!LstSubject.SetFocus

        Exit Sub

    Else

        ' Trim off leading comma.

        strSubjCriteria = Mid$(strSubjCriteria, 2)

    End If

   ' Build a list of the Category selections.

    With Me!LstCategory

        For Each Itm In .ItemsSelected

            strCatCriteria = strCatCriteria & "," & Chr(34) & .ItemData(Itm) & Chr(34)

        Next Itm

    End With

    If Len(strCatCriteria) = 0 Then

        MsgBox _

            "You must select one or more items in the list box!", _

            vbExclamation, _

            "No Selection Made"

        Me!LstCategory.SetFocus

       Exit Sub

    Else

        ' Trim off leading comma.

        strCatCriteria = Mid$(strCatCriteria, 2)

    End If

   ' Modify the Query.

    Set DB = CurrentDb()

    Set Q = DB.QueryDefs("MultiSelect")

    Q.SQL = "Select * From BabyData Where [Subject] In(" & strSubjCriteria & _

      ") And [Category] In (" & strCatCriteria & _

      ");"

    Q.Close

   ' Run the query.

    DoCmd.OpenQuery "MultiSelect"

End Sub

'------ end of code ------