Filtering report by date range and multiple list boxes (1 Viewer)

[jlb4350]

If you pretty much copy the code I created and amend for the different names (listbox, field etc) then it should just work. The correct logic is there I believe.

I have done as you asked/were looking for. You have an example that works.

I'm not an expert here, it takes me a while to even create a short piece of code like that. Often I have to Google for the correct syntax, which is why I went back to your method for identifying selected items.

Sorry for the late reply. Thank you for your help and example. I tried it and gave an error, but it did give me direction on how I can make it work. After several more hours over the weekend, I managed to come up with this code, based on all the replies to this post. It may not be the most efficient way, but it seems to work.

Option Compare Database

Private Sub cmdPreview_Click()
'On Error GoTo Err_Handler      'Remove the single quote from start of this line once you have it working.
    'Purpose:       Filter a report to a date range.
    'Note:          Filter uses "less than the next day" in case the field has a time component.
    
    Dim strReport As String
    Dim strDateField As String
    Dim strWhere As String
    Dim lngView As Long
    Dim ctl As Control
    Dim varItem As Variant
    Dim lngLen1 As String
    Dim lngLen2 As String
    Dim lngLen3 As String
    Dim strDelim As String
    Dim strInDrug As String
    Dim strInDesc As String
    Dim strInRecType As String
    Dim strDescrip As String    'Description of WhereCondition
    Const strcJetDate = "\#mm\/dd\/yyyy\#"  'Do NOT change this format.
    
    strReport = "rptRecentChanges"
    strDateField = "[EffectiveDate]"
    lngView = acViewReport     'Use acViewNormal to print instead of preview.
    
    'Build the filter string.
    If IsDate(Me.txtStartDate) Then
        strWhere = "(" & strDateField & " >= " & Format(Me.txtStartDate, strcJetDate) & ")"
    End If
    
    If IsDate(Me.txtEndDate) Then
        If strWhere <> vbNullString Then
            strWhere = strWhere & " AND "
        End If
        strWhere = strWhere & "(" & strDateField & " < " & Format(Me.txtEndDate + 1, strcJetDate) & ")"
    End If
        
'Check list boxes
    With Me.lstDrugProduct
        For Each varItem In .ItemsSelected
            If Not IsNull(varItem) Then
                strInDrug = strInDrug & """" & lstDrugProduct.ItemData(varItem) & """, "
            End If
        Next
    End With

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

 With Me.lstRecordType
        For Each varItem In .ItemsSelected
            If Not IsNull(varItem) Then
                strInRecType = strInRecType & """" & lstRecordType.ItemData(varItem) & """, "
            End If
        Next
    End With
        
    lngLen1 = Len(strInDrug) - 2
    If lngLen1 > 0 Then
        strWhere = strWhere & " AND [DrugProduct] IN (" & Left$(strInDrug, lngLen1) & ")"
    End If
    
     lngLen2 = Len(strInDesc) - 2
    If lngLen2 > 0 Then
        strWhere = strWhere & " AND [Description] IN (" & Left$(strInDesc, lngLen2) & ")"
    End If
    
     lngLen3 = Len(strInRecType) - 2
    If lngLen3 > 0 Then
        strWhere = strWhere & " AND [RecordType] IN (" & Left$(strInRecType, lngLen3) & ")"
    End If
        
    'Close the report if already open: otherwise it won't filter properly.
    If CurrentProject.AllReports(strReport).IsLoaded Then
        DoCmd.Close acReport, strReport
    End If

    'Open the report.
    Debug.Print strWhere        'Remove the single quote from the start of this line for debugging purposes.
    DoCmd.OpenReport strReport, lngView, , strWhere

Exit_Handler:
    Exit Sub

Err_Handler:
    If Err.Number <> 2501 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Cannot open report"
    End If
    Resume Exit_Handler
End Sub

The only problem I'm having now is that when a selection is made from one of the list boxes, and not in the date boxes, it throws an error, but that's something I can work out eventually. I'll just have to remind the user to enter a date until I can figure out the bug. I'm sure there needs to be an IF statement in there that I'm missing.

Thanks again for everyone's feedback. I'll update again when I have the full working code.

 

[Gasman]

Do as you did with txtEndDate

test to see if strwhere has anything, if it has then add the AND and then add the IN ()
Repeat for the listboxes.
Debug.Print strWhere and the rest to get the syntax correct.