AlmostThere AlmostThere - 4 months ago 14
SQL Question

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

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