VBA Query based on multiple “multiple select list boxes” in Access when not selecting an item from one of the multiple select boxes

I have the following vba that creates a query in a test Access database. I have two multiple select list boxes. The issue is, i want to be able to select multiple items from “Me![State]” and none from “Me![Animal]” and be able to run the query. However, this is not possible as the query language is not set up to handle that. It makes me select something from “Me![Animal]”.

How do i revise the vba below to allow me to query on both multiple selection list boxes if one of the multiple list boxes does not have anything selected or if both have selections in them?

Private Sub Command6_Click()


  Dim Q As QueryDef, DB As Database
   Dim Criteria As String
   Dim ctl As Control
   Dim Itm As Variant
   Dim ctl2 As Control
   Dim ctl3 As Control
   ' Build a list of the selections.


   Set ctl = Me![Animal]
   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



      Set ctl2 = Me![State]
   For Each Itm In ctl2.ItemsSelected
      If Len(Criteria2) = 0 Then
         Criteria2 = Chr(34) & ctl2.ItemData(Itm) & Chr(34)
      Else
         Criteria2 = Criteria2 & "," & Chr(34) & ctl2.ItemData(Itm) _
          & Chr(34)
      End If
   Next Itm
   If Len(Criteria2) = 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("animalquery")
   ' Modify the Query.
   Set DB = CurrentDb()
   Set Q = DB.QueryDefs("animalquery")
   Q.SQL = "Select * From [table1] Where [table1].[type] In (" & "'Animal'" & _
     ")" & " and [table1].[animal] in (" & Criteria & _
     ")" & " and [table1].[state] in (" & Criteria2 & _
     ")" & ";"
   Q.Close

   ' Run the query.
   DoCmd.OpenQuery "animalquery"
End Sub

Answer

EDIT – Fix comparison as per comment

You can do this with a simple check of your Criteria vaiables.

You already do the the length check – just use it later on when you build the dynamic SQL.

I added a strSQL variable to make it easier to track what’s happening. And adjusted the error message to allow one or other criteria being empty

Private Sub Command6_Click()

    Dim Q           As QueryDef
    Dim DB          As Database
    Dim Criteria    As String
    Dim ctl         As Control
    Dim Itm         As Variant
    Dim ctl2        As Control
    Dim ctl3        As Control

    ' Use for dynamic SQL statement'
    Dim strSQL      As String

    Set ctl = Me![Animal]
    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

    Set ctl2 = Me![State]
    For Each Itm In ctl2.ItemsSelected
        If Len(Criteria2) = 0 Then
            Criteria2 = Chr(34) & ctl2.ItemData(Itm) & Chr(34)
        Else
            Criteria2 = Criteria2 & "," & Chr(34) & ctl2.ItemData(Itm) & Chr(34)
        End If
    Next Itm

    If (Len(Criteria) = 0) And (Len(Criteria2) = 0) Then
        Itm = MsgBox("You must select one or more items from one of the list boxes!", 0, "No Selection Made")
        Exit Sub
    End If

    ' Modify the Query.
    Set DB = CurrentDb()
    Set Q = DB.QueryDefs("animalquery")
    ' Modify the Query.
    Set DB = CurrentDb()
    Set Q = DB.QueryDefs("animalquery")

    strSQL = "Select * From [table1] Where [table1].[type] In (" & "'Animal')"

    If (Len(Criteria) <> 0) Then ' Append Animal Criteria
        strSQL = strSQL & " AND [table1].[animal] IN (" & Criteria & ")"
    End If
    If (Len(Criteria2) <> 0) Then ' Append State Criteria
        strSQL = strSQL & " AND [table1].[state]  IN (" & Criteria2 & ")"
    End If

    Q.SQL = strSQL
    Q.Close

    ' Run the query.
    DoCmd.OpenQuery "animalquery"
End Sub