Report with Multiple Multi-Select List Boxes

[pkeller]

I have code attached to the OK button on a form which has two list boxes. The first list box is a general category and the second list box is for a more specific category (example: Category 1 = Type of Vehicle, Category 2 = Manufacturer).

Currently I have this all set up for just one category, in this case my more specific category. I am trying to modify my code to work the same way it is but with two list boxes. I have tried appending to what I have but I can't seem to get it to work, suggestions?

Below is what I have and what works for ONE category:

Private Sub OK_Click()

On Error GoTo Err_OK_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 tblIssues2"

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

'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE [Category] 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

MyDB.QueryDefs.Delete "qryIssues2"
Set qdef = MyDB.CreateQueryDef("qryIssues2", strSQL)

'Open the query, built using the IN clause to set the criteria
'DoCmd.OpenQuery "qryIssues2", acViewNormal

'Clear listbox selection after running query
For Each varItem In Me.LstCategory.ItemsSelected
Me.LstCategory.Selected(varItem) = False
Next varItem


Exit_OK_Click:
Me.Visible = False
Exit Sub

Err_OK_Click:

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

 

[dhookom]

I like to use a generic function that can be called from any code.

A typical method of using this would be:

   Dim strWhere as String 
   strWhere = " 1=1 " 
   strWhere = strWhere & BuildIn(Me.lboTColor) 
   strWhere = strWhere & BuildIn(Me.lboNEmpID) 
   DoCmd.OpenReport "rptA", acViewPreview, , strWhere

Function BuildIn(lboListBox As ListBox) As String 
    'send in a list box control object 
    ' the list box name must begin with _ 
        "lbo" and be followed by one character describing the data type _ 
        "T" for Text _ 
        "N" for Numeric or _ 
        "D" for Date  and then the 5th characters on for the _ 
        field name ie: lboEmployeeID 
    Dim strIn As String 
    Dim varItem As Variant 
    Dim strDelim   'used for delimiter 
    'Set the delimiter used in the IN (...) clause 
    Select Case Mid(lboListBox.Name, 4, 1) 
    Case "T"  'text data type 
        strDelim = "'"  'double quote 
    Case "N"  'numeric data type 
        strDelim = "" 
    Case "D"  'Date data type 
        strDelim = "#" 
    End Select 


    If lboListBox.ItemsSelected.Count > 0 Then 
        strIn = " AND [" & Mid(lboListBox.Name, 5) & "] In (" 
        For Each varItem In lboListBox.ItemsSelected 
            strIn = strIn & strDelim & lboListBox.ItemData(varItem) & 
strDelim & ", " 
        Next 
        'remove the last ", " and add the ")" 
        strIn = Left(strIn, Len(strIn) - 2) & ") " 
    End If 
    BuildIn = strIn 


End Function

Duane
Hook'D on Access
MS Access MVP

 

[pkeller]

Thanks Dhookom, but I am not sure I am seeing where your code allows for two separate listbox multi selections to be brought into my query. The datatype for my purpose will always be text from my two separate multiple selection list boxes. I have tried adding "AND" to my strWhere to account for the two different categories that should be showing up in my query but it doesn't seem to let me.

 

[pkeller]

I am posting up the code I am using currently to try to get both boxes to work. It gives me an error on my " AND [Category] in " & _ ..... Statement

Private Sub OK_Click()
    
    On Error GoTo Err_OK_Click
    Dim MyDB As DAO.Database
    Dim qdef As DAO.QueryDef
    Dim t As Integer
    Dim i As Integer
    Dim strSQL As String
    Dim strWhere As String
    Dim strIN1 As String
    Dim strIN2 As String
    Dim flgSelectAll As Boolean
    Dim varItem1 As Variant
    Dim varItem2 As Variant
    Set MyDB = CurrentDb()

    strSQL = "SELECT * FROM tblIssues2"

    'Build the IN string by looping through the listbox
    For t = 0 To LstTier.ListCount - 1
        If LstTier.Selected(t) Then
            If LstTier.Column(0, t) = "* ALL TIERS *" Then
                flgSelectAll = True
            End If
            strIN1 = strIN1 & "'" & LstTier.Column(0, t) & "',"
        End If
    Next t
    'Build the IN string by looping through the listbox
    For i = 0 To LstCategory.ListCount - 1
        If LstCategory.Selected(i) Then
            If LstCategory.Column(0, i) = "* ALL CATEGORIES *" Then
                flgSelectAll = True
            End If
            strIN2 = strIN2 & "'" & LstCategory.Column(0, i) & "',"
        End If
    Next i

    'Create the WHERE string, and strip off the last comma of the IN string
    strWhere = " WHERE [Tier] in " & _
               "(" & Left(strIN1, Len(strIN1) - 1) & ")"
               " AND [Category] in " & _
               "(" & Left(strIN2, Len(strIN2) - 1) & ")"
               
    'If "All" was selected in the listbox, don't add the WHERE condition
    If Not flgSelectAll Then
        strSQL = strSQL & strWhere
    End If

    MyDB.QueryDefs.Delete "qryIssues2"
    Set qdef = MyDB.CreateQueryDef("qryIssues2", strSQL)

    'Open the query, built using the IN clause to set the criteria
    DoCmd.OpenQuery "qryIssues2", acViewNormal

    'Clear listbox selection after running query
    For Each varItem1 In Me.LstCategory.ItemsSelected
        Me.LstCategory.Selected(varItem1) = False
    Next varItem1
    For Each varItem2 In Me.LstTier.ItemsSelected
        Me.LstTier.Selected(varItem2) = False
    Next varItem2

Exit_OK_Click:
    Me.Visible = False
    Exit Sub

Err_OK_Click:

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

 

[pkeller]

I figured it out, I changed part of my code as follows

'Create the WHERE string, and strip off the last comma of the IN string
    strWhere1 = " WHERE [Tier] in " & _
               "(" & Left(strIN1, Len(strIN1) - 1) & ")"
    strWhere2 = " AND [Category] in " & _
               "(" & Left(strIN2, Len(strIN2) - 1) & ")"

hopefully this should help anyone with a similar issue (and yes I realize my "select all" selection isn't all hooked up yet but that should be easy enough to fix)

 

[pkeller]

FINAL working code in case anyone ever wants to refer to this:

Private Sub OK_Click()
    
    On Error GoTo Err_OK_Click
    Dim MyDB As DAO.Database
    Dim qdef As DAO.QueryDef
    Dim t As Integer
    Dim i As Integer
    Dim strSQL As String
    Dim strWhere1 As String
    Dim strWhere2 As String
    Dim strWhere3 As String
    Dim strIN1 As String
    Dim strIN2 As String
    Dim flgSelectAll1 As Boolean
    Dim flgSelectAll2 As Boolean
    Dim varItem1 As Variant
    Dim varItem2 As Variant
    Set MyDB = CurrentDb()

    strSQL = "SELECT * FROM tblIssues2"

    'Build the IN string by looping through the listbox
    For t = 0 To LstTier.ListCount - 1
        If LstTier.Selected(t) Then
            If LstTier.Column(0, t) = "* ALL TIERS *" Then
                flgSelectAll1 = True
            End If
            strIN1 = strIN1 & "'" & LstTier.Column(0, t) & "',"
        End If
    Next t
    'Build the IN string by looping through the listbox
    For i = 0 To LstCategory.ListCount - 1
        If LstCategory.Selected(i) Then
            If LstCategory.Column(0, i) = "* ALL CATEGORIES *" Then
                flgSelectAll2 = True
            End If
            strIN2 = strIN2 & "'" & LstCategory.Column(0, i) & "',"
        End If
    Next i

    'Create the WHERE string, and strip off the last comma of the IN string
    strWhere1 = " WHERE [Tier] in " & _
               "(" & Left(strIN1, Len(strIN1) - 1) & ")"
    strWhere2 = " AND [Category] in " & _
               "(" & Left(strIN2, Len(strIN2) - 1) & ")"
    strWhere3 = " WHERE [Category] in " & _
               "(" & Left(strIN2, Len(strIN2) - 1) & ")"
               
    'If "All" was selected in the listbox, don't add the WHERE condition
    If Not flgSelectAll1 And Not flgSelectAll2 Then
        strSQL = strSQL & strWhere1 & strWhere2
    End If
    
    If flgSelectAll1 = True And flgSelectAll2 = False Then
        strSQL = strSQL & strWhere3
    End If

    If flgSelectAll2 = True And flgSelectAll1 = False Then
        strSQL = strSQL & strWhere1
    End If

    MyDB.QueryDefs.Delete "qryIssues2"
    Set qdef = MyDB.CreateQueryDef("qryIssues2", strSQL)

    'Open the query, built using the IN clause to set the criteria
    DoCmd.OpenQuery "qryIssues2", acViewNormal

    'Clear listbox selection after running query
    For Each varItem1 In Me.LstCategory.ItemsSelected
        Me.LstCategory.Selected(varItem1) = False
    Next varItem1
    For Each varItem2 In Me.LstTier.ItemsSelected
        Me.LstTier.Selected(varItem2) = False
    Next varItem2

Exit_OK_Click:
    Me.Visible = False
    Exit Sub

Err_OK_Click:

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

 

[dhookom]

I much prefer to use a standard function rather than copying the same basic code again and again. However, it's good to hear you got your code working as you need.

Duane
Hook'D on Access
MS Access MVP