use multiple extended lisboxes to filter a report

dorien90

New member
Local time
Today, 19:34
Joined
Mar 1, 2013
Messages
5
Hey everyone,

I'm using Ms access 2007 (& VBA) and I have some problems with the following:

I have a form ( frmSelectRTC) and I want to use it to apply a filter on a report. On this from (frmSelectRTC) there are 3 extended listboxes on which you can filter.
It should be possible to chose only one of the 3 listboxes to filter, I don't want to be obliged to chose something from all 3 listboxes . At this point, with the code that I have found on internet ( Allen Brown) I am obliged to chose one option of each listbox.

You can find the code that I have used hereafter. I already know that the problem is with the "And", "And", "And"...
Maybe someone can take a look at it and give me some advise on how to solve this problem.

Thanks in advance!

Code:
Private Sub cmdApplyFilter_Click()
On Error GoTo Err_Handler
Dim varItem As Variant
Dim strWhere As String
Dim strWhere2 As String
Dim strWhere3 As String
Dim strDescrip As String
Dim strDescrip2 As String
Dim strDescrip3 As String
Dim lngLen As Long
Dim strDelim As String
Dim strDoc As String

'strDelim = """"
strDoc = "rptAllOpportunities"

'Loop through the ItemSelected in the listbox
With Me.lboRegion
    For Each varItem In .ItemsSelected
        If Not IsNull(varItem) Then
        'Build up the filter from the bound column (hidden)
        strWhere = strWhere & strDelim & .ItemData(varItem) & strDelim & ","
        'Build up the description from the text in the visible column
        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 = "[RegionID] IN (" & Left$(strWhere, lngLen) & ")"
    lngLen = Len(strDescrip) - 2
    If lngLen > 0 Then
        strDescrip = "Region: " & Left$(strDescrip, lngLen)
    End If
End If

'Loop through the ItemSelected in the listbox
With Me.lboType
    For Each varItem In .ItemsSelected
        If Not IsNull(varItem) Then
        'Build up the filter from the bound column (hidden)
        strWhere2 = strWhere2 & strDelim & .ItemData(varItem) & strDelim & ","
        'Build up the description from the text in the visible column
        strDescrip2 = strDescrip2 & """" & .Column(1, varItem) & ""","
    End If
Next
End With

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

'Loop through the ItemSelected in the listbox
With Me.lboCommodity
    For Each varItem In .ItemsSelected
        If Not IsNull(varItem) Then
        'Build up the filter from the bound column (hidden)
        strWhere3 = strWhere3 & strDelim & .ItemData(varItem) & strDelim & ","
        'Build up the description from the text in the visible column
        strDescrip3 = strDescrip3 & """" & .Column(1, varItem) & ""","
    End If
Next
End With

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

'Report will not filter if open, so close it.
If CurrentProject.AllReports(strDoc).IsLoaded Then
    DoCmd.Close acReport, strDoc
End If

'Omit the last argument
DoCmd.OpenReport strDoc, acViewReport, , Wherecondition:=strWhere & " AND " & strWhere2 & " AND " & strWhere3, OpenArgs:=strDescrip & "   " & strDescrip2 & "   " & strDescrip3

Exit_Handler:
    Exit Sub

Err_Handler:
    If Err.Number <> 2501 Then
        MsgBox "Error" & Err.Number & "-" & Err.Description, , "cmdApplyFilter_Click"
    End If
    Resume Exit_Handler
End Sub
 
Hi everyone,

Is there someone who can help me and give me some advise about this?
I really need your help.

Thank you!
 
Assuming the code you have works when all three are selected, try replacing this code
Code:
'Omit the last argument
DoCmd.OpenReport strDoc, acViewReport, , Wherecondition:=strWhere & " AND " & strWhere2 & " AND " & strWhere3, OpenArgs:=strDescrip & "   " & strDescrip2 & "   " & strDescrip3

with this:

Code:
If strWhere <> "" And strWhere2 <> "" Then
    strWhere2 = " AND " & strWhere2
End If
If strWhere & strWhere2 <> "" And strWhere3 <> "" Then
    strWhere3 = " AND " & strWhere3
End If
    
'Omit the last argument
DoCmd.OpenReport strDoc, acViewReport, , Wherecondition:=strWhere & strWhere2 & strWhere3, OpenArgs:=strDescrip & "   " & strDescrip2 & "   " & strDescrip3

I'm not sure if something similar would be needed with the three strDescrip variables. It might work as is, since it would just be a concatenation of blanks and nulls. Good luck!
 

Users who are viewing this thread

Back
Top Bottom