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!
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