Multi-Select in List Box

G

Guest

I borrowed example from another Access MVP and all works well

Private Sub cmdPreview_Click()
On Error GoTo Err_Handler

Dim varItem As Variant
Dim strWhere As String
Dim strDescrip As String
Dim lngLen As Long
Dim strDelim As String
Dim strDoc As String

strDoc = "Products by Category"

With Me.lstCategory
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere = strWhere & strDelim & .ItemData(varItem) &
strDelim & ","
strDescrip = strDescrip & """" & .Column(1, varItem) & """, "
End If
Next
End With

'Remove trailing comma. Add field name, IN operator, and brackets.
lngLen = Len(strWhere) - 1
If lngLen > 0 Then
strWhere = "[CategoryID] IN (" & Left$(strWhere, lngLen) & ")"
lngLen = Len(strDescrip) - 2
If lngLen > 0 Then
strDescrip = "Categories: " & Left$(strDescrip, lngLen)
End If
End If

If CurrentProject.AllReports(strDoc).IsLoaded Then
DoCmd.Close acReport, strDoc
End If

DoCmd.OpenReport strDoc, acViewPreview, WhereCondition:=strWhere,
OpenArgs:=strDescrip

Exit_Handler:
Exit Sub

Err_Handler:
If Err.Number <> 2501 Then 'Ignore "Report cancelled" error.
MsgBox "Error " & Err.Number & " - " & Err.Description, ,
"cmdPreview_Click"
End If
Resume Exit_Handler
End Sub

MY PROBLEM IS:

I have an additional List Box on my form (lstBrand) with columns BrandID and
Brand. HOW do I add additional code and WHERE do I place it in the above
example when multiple list boxes are used on the same form? Can anyone help
me?
 
D

Douglas J. Steele

Private Sub cmdPreview_Click()
On Error GoTo Err_Handler

Dim varItem As Variant
Dim strWhere As String
Dim strWhere1 As String
Dim strWhere2 As String
Dim strDescrip As String
Dim strDescrip1 As String
Dim strDescrip2 As String
Dim lngLen As Long
Dim strDelim As String
Dim strDoc As String

strDoc = "Products by Category"

With Me.lstCategory
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere1 = strWhere1 & strDelim & .ItemData(varItem) & strDelim &
","
strDescrip1 = strDescrip1 & """" & .Column(1, varItem) & """, "
End If
Next varItem
End With

' Remove trailing comma. Add field name, IN operator, and brackets.
lngLen = Len(strWhere1) - 1
If lngLen > 0 Then
strWhere1 = "[CategoryID] IN (" & Left$(strWhere1, lngLen) & ") "
lngLen = Len(strDescrip1) - 2
If lngLen > 0 Then
strDescrip1 = "Categories: " & Left$(strDescrip1, lngLen)
End If
End If

With Me.lstBrand
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere2 = strWhere2 & strDelim & .ItemData(varItem) & strDelim &
","
strDescrip2 = strDescrip2 & """" & .Column(1, varItem) & """, "
End If
Next varItem
End With

' Remove trailing comma. Add field name, IN operator, and brackets.
lngLen = Len(strWhere1) - 1
If lngLen > 0 Then
strWhere2 = "[BrandID] IN (" & Left$(strWhere2, lngLen) & ") "
lngLen = Len(strDescrip2) - 2
If lngLen > 0 Then
strDescrip2 = "Brands: " & Left$(strDescrip2, lngLen)
End If
End If

strWhere = strWhere1
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND "
End If
strWhere = strWhere & strWhere2

strDescrip = strDescrip1
If Len(strDescrip) > 0 Then
strDescrip = strDescrip & ";"
End If
strDescrip = strDescrip & strDescrip2

If CurrentProject.AllReports(strDoc).IsLoaded Then
DoCmd.Close acReport, strDoc
End If

DoCmd.OpenReport strDoc, acViewPreview, _
WhereCondition:=strWhere, OpenArgs:=strDescrip

Exit_Handler:
Exit Sub

Err_Handler:
If Err.Number <> 2501 Then 'Ignore "Report cancelled" error.
MsgBox "Error " & Err.Number & " - " & Err.Description, _
, "cmdPreview_Click"
End If
Resume Exit_Handler

End Sub

To be honest, I don't understand why you're passing strDescrip as the
OpenArgs, since you already know which values will be selected due to the
Where clause.
 
G

Guest

You definitely got me up and going. So far, I have the following, but this
code requires that all (4) of my List boxes have at least one selection.
What would I add or change to allow selection of NO list box. I have a date
field on the form that is always used and my list boxes don't necessarily
require a selection.

Private Sub OK_Click()
On Error GoTo OK_Click_Err
Dim varItem As Variant
Dim strWhere As String
Dim strWhere1 As String
Dim strWhere2 As String
Dim strWhere3 As String
Dim strWhere4 As String
Dim lngLen As Long
Dim strDelim As String
Dim strDoc As String

strDoc = "rptCatalogTEST"

With Me.lstBrand
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere1 = strWhere1 & strDelim & .ItemData(varItem) & strDelim & ","
End If
Next varItem
End With

lngLen = Len(strWhere1) - 1
If lngLen > 0 Then
strWhere1 = "[SupplierID] IN (" & Left$(strWhere1, lngLen) & ") "
End If

With Me.lstGroup
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere2 = strWhere2 & strDelim & .ItemData(varItem) & strDelim & ","
End If
Next varItem
End With

lngLen = Len(strWhere2) - 1
If lngLen > 0 Then
strWhere2 = "[GroupID] IN (" & Left$(strWhere2, lngLen) & ") "
End If

With Me.lstMake
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere3 = strWhere3 & strDelim & .ItemData(varItem) & strDelim & ","
End If
Next varItem
End With

lngLen = Len(strWhere3) - 1
If lngLen > 0 Then
strWhere3 = "[CodeID] IN (" & Left$(strWhere3, lngLen) & ") "
End If

With Me.lstType
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere4 = strWhere4 & strDelim & .ItemData(varItem) & strDelim & ","
End If
Next varItem
End With

lngLen = Len(strWhere4) - 1
If lngLen > 0 Then
strWhere4 = "[TypeID] IN (" & Left$(strWhere4, lngLen) & ") "
End If

'WHAT IS NEEDED OR CHANGED IF ONLY (1) OR NO LIST BOX IS SELECTED?
strWhere = strWhere1
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND "
End If
strWhere = strWhere & strWhere2 & " AND "
strWhere = strWhere & strWhere3 & " AND "
strWhere = strWhere & strWhere4

If CurrentProject.AllReports(strDoc).IsLoaded Then
DoCmd.Close acReport, strDoc
End If

DoCmd.OpenReport strDoc, acViewPreview, _
WhereCondition:=strWhere

DoCmd.Close acForm, "frmSelectCriteriaCatalogTEST"

OK_Click_Exit:
Exit Sub

OK_Click_Err:
MsgBox Err.Description
Resume OK_Click_Exit

End Sub

Where do I go from here?

Thanks, Stu

Douglas J. Steele said:
Private Sub cmdPreview_Click()
On Error GoTo Err_Handler

Dim varItem As Variant
Dim strWhere As String
Dim strWhere1 As String
Dim strWhere2 As String
Dim strDescrip As String
Dim strDescrip1 As String
Dim strDescrip2 As String
Dim lngLen As Long
Dim strDelim As String
Dim strDoc As String

strDoc = "Products by Category"

With Me.lstCategory
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere1 = strWhere1 & strDelim & .ItemData(varItem) & strDelim &
","
strDescrip1 = strDescrip1 & """" & .Column(1, varItem) & """, "
End If
Next varItem
End With

' Remove trailing comma. Add field name, IN operator, and brackets.
lngLen = Len(strWhere1) - 1
If lngLen > 0 Then
strWhere1 = "[CategoryID] IN (" & Left$(strWhere1, lngLen) & ") "
lngLen = Len(strDescrip1) - 2
If lngLen > 0 Then
strDescrip1 = "Categories: " & Left$(strDescrip1, lngLen)
End If
End If

With Me.lstBrand
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere2 = strWhere2 & strDelim & .ItemData(varItem) & strDelim &
","
strDescrip2 = strDescrip2 & """" & .Column(1, varItem) & """, "
End If
Next varItem
End With

' Remove trailing comma. Add field name, IN operator, and brackets.
lngLen = Len(strWhere1) - 1
If lngLen > 0 Then
strWhere2 = "[BrandID] IN (" & Left$(strWhere2, lngLen) & ") "
lngLen = Len(strDescrip2) - 2
If lngLen > 0 Then
strDescrip2 = "Brands: " & Left$(strDescrip2, lngLen)
End If
End If

strWhere = strWhere1
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND "
End If
strWhere = strWhere & strWhere2

strDescrip = strDescrip1
If Len(strDescrip) > 0 Then
strDescrip = strDescrip & ";"
End If
strDescrip = strDescrip & strDescrip2

If CurrentProject.AllReports(strDoc).IsLoaded Then
DoCmd.Close acReport, strDoc
End If

DoCmd.OpenReport strDoc, acViewPreview, _
WhereCondition:=strWhere, OpenArgs:=strDescrip

Exit_Handler:
Exit Sub

Err_Handler:
If Err.Number <> 2501 Then 'Ignore "Report cancelled" error.
MsgBox "Error " & Err.Number & " - " & Err.Description, _
, "cmdPreview_Click"
End If
Resume Exit_Handler

End Sub

To be honest, I don't understand why you're passing strDescrip as the
OpenArgs, since you already know which values will be selected due to the
Where clause.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no private e-mails, please)


Stu said:
I borrowed example from another Access MVP and all works well
MY PROBLEM IS:

I have an additional List Box on my form (lstBrand) with columns BrandID
and
Brand. HOW do I add additional code and WHERE do I place it in the above
example when multiple list boxes are used on the same form? Can anyone
help
me?
 
B

Bob Quintal

You definitely got me up and going. So far, I have the following,
but this code requires that all (4) of my List boxes have at least
one selection. What would I add or change to allow selection of
NO list box. I have a date field on the form that is always used
and my list boxes don't necessarily require a selection.

'WHAT IS NEEDED OR CHANGED IF ONLY (1) OR NO LIST BOX IS
SELECTED?
strWhere = strWhere1
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND "
End If
strWhere = strWhere & strWhere2 & " AND "
strWhere = strWhere & strWhere3 & " AND "
strWhere = strWhere & strWhere4

You need to test for length of 0 in each of the strWheres.

strWhere = strWhere1
If Len(strWhere) > 0 and Len(strWhere2) > 0 then
strWhere = strWhere & " AND " & strWhere2
else
strWhere = strWhere & strWhere2
End if
If Len(strWhere) > 0 and Len(strWhere3) > 0 then
strWhere = strWhere & " AND " & strWhere3
else
strWhere = strWhere & strWhere3
End if
If Len(strWhere) > 0 and Len(strWhere4) > 0 then
strWhere = strWhere & " AND " & strWhere4
else
strWhere = strWhere & strWhere4
End if
 
G

Guest

Thank You so much. Works perfectly!!

Bob Quintal said:
You need to test for length of 0 in each of the strWheres.

strWhere = strWhere1
If Len(strWhere) > 0 and Len(strWhere2) > 0 then
strWhere = strWhere & " AND " & strWhere2
else
strWhere = strWhere & strWhere2
End if
If Len(strWhere) > 0 and Len(strWhere3) > 0 then
strWhere = strWhere & " AND " & strWhere3
else
strWhere = strWhere & strWhere3
End if
If Len(strWhere) > 0 and Len(strWhere4) > 0 then
strWhere = strWhere & " AND " & strWhere4
else
strWhere = strWhere & strWhere4
End if
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top