Two multiselect listboxes and date ranges (1 Viewer)

masa1

Registered User.
Local time
Today, 13:14
Joined
Oct 1, 2018
Messages
18
Hi to all!
In the database I'm trying to create, I need to apply filtering using 2 multi-select listbox and 2 date ranges.
In this forum I found a code that largely meets my needs.
However, I can't modify the way I would like!
i.e. when I select element the ListEngineType, ListReparType , txtStartDateFrom, txtEndDateFrom, txtStartDateFinish and txtEndDateFinish fields, I get the result I expected.
If I skip the ListReparType (blank) or any date fields, everything is OK too.
If I skip the ListEngineType (blank) list or any date fields, everything is OK too.
However, when both list boxes are empty and only dates are selected, I get an error and no results.
I devoted a lot of time to working it out myself but to no avail ...
Could you please help me?

The code I'm trying to adapt to my needs;
Code Tags Added by UG
Code:
Private Sub cmdSearch_Click()
'https://www.access-programmers.co.uk/forums/threads/filtering-report-by-date-range-and-multiple-list-boxes.304545/
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 strForm 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 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.
   
    strForm = "frmSearchEngine"
    strDateField = "[StartDate]"
    lngView = acNormal     'Use acNormal
     

    'Date field example. Use the format string to add the # delimiters and get the right international format.
    If Not IsNull(Me.txtStartDateFrom) Then
        strWhere = strWhere & "([StartDate] >= " & Format(Me.txtStartDateFrom, strcJetDate) & ") AND"
    End If
    'Debug.Print strWhere
   
    If Not IsNull(Me.txtEndDateFrom) Then   'Less than the next day.
        strWhere = strWhere & "([StartDate] <= " & Format(Me.txtEndDateFrom, strcJetDate) & ") AND" ' 
    End If
   
   
    If Not IsNull(Me.txtStartDateFinish) Then
        strWhere = strWhere & "([DateFinish] >= " & Format(Me.txtStartDateFinish, strcJetDate) & ") AND "
    End If
   
    If Not IsNull(Me.txtEndDateFinish) Then   'Less than the next day.
        strWhere = strWhere & "([DateFinish] <= " & Format(Me.txtEndDateFinish, strcJetDate) & ") AND "
    End If
   
   'Debug.Print strWhere
   
   
    'Check list boxes
    With Me.ListEngineType          'ListEngineType
        For Each varItem In .ItemsSelected
            If Not IsNull(varItem) Then
                strInDrug = strInDrug & """" & ListEngineType.ItemData(varItem) & """, "
            End If
        Next varItem
    End With
    'Debug.Print strInDrug
   
     With Me.ListReparType          'ListReparType
        For Each varItem In .ItemsSelected
            If Not IsNull(varItem) Then
                strInDesc = strInDesc & """" & ListReparType.ItemData(varItem) & """, "
            End If
        Next varItem
    End With
       
    lngLen1 = Len(strInDrug) - 2
    If lngLen1 > 0 Then
        strWhere = strWhere & " [EngineType] IN (" & Left$(strInDrug, lngLen1) & ")"     '
    End If
   
    'Debug.Print strWhere
   
   lngLen2 = Len(strInDesc) - 2
    If lngLen2 > 0 Then
        strWhere = strWhere & " AND [ReparType] IN (" & Left$(strInDesc, lngLen2) & ")" '   AND
    End If
    'Debug.Print strWhere

    DoCmd.OpenForm strForm, acNormal, , 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
 
Last edited by a moderator:

theDBguy

I’m here to help
Staff member
Local time
Today, 13:14
Joined
Oct 29, 2018
Messages
13,185
Hi. If you look in the Immediate Window, what do you see as the result of the last Debug.Print? It should give you a clue.
 

masa1

Registered User.
Local time
Today, 13:14
Joined
Oct 1, 2018
Messages
18
Hi.
Thank you for reading about my problem.

...when both list boxes are empty and only dates are selected, I get an error and no results.
...in the Immediate Window;
([StartDate] >= #01/01/2019#) AND([StartDate] <= #12/30/2019#) AND([DateFinish] >= #01/01/2019#) AND ([DateFinish] <= #12/30/2019#) AND

I can't use it.
 

masa1

Registered User.
Local time
Today, 13:14
Joined
Oct 1, 2018
Messages
18
Thank you for waking me up.
It was enough to remove AND ...

If Not IsNull(Me.txtEndDateFinish) Then 'Less than the next day.
strWhere = strWhere & "([DateFinish] <= " & Format(Me.txtEndDateFinish, strcJetDate) & ") " 'AND
End If



Thank you and best regards.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 13:14
Joined
Oct 29, 2018
Messages
13,185
Hi. Glad to hear you got it sorted out. Good luck with your project.
 

masa1

Registered User.
Local time
Today, 13:14
Joined
Oct 1, 2018
Messages
18
'Hi to all.
'In my earlier post I was overly optimistic. I thought everything was good.
'However, I didn't notice the error.
'What is my problem?
'Well, I'm trying to apply the criteria to view the continuous form.
'I want to use TWO multiselect list boxes and TWO date ranges for this.
'ALL COMBINATIONS OPERATE CORRECTLY WITH THE EXCEPTION OF ONE!
'Well, if I leave the "txtEndDateFinish" control blank (Null), I don't get any results
'And the preview window immediately I get the following result;

'([StartDate]> = # 01/01/2019 #) AND ([StartDate] <= # 12/30/2019 #) AND ([DateFinish]> = # 01/01/2019 #) AND ([DateFinish] <= 01-01-2100)
'As you can see I tried to replace the Null value with the Nz function. I don't understand why the date is different, without the "#" characters.
'Maybe that's the reason.
'Could you please help me?

strForm = "frmSearchEngine"
StartDate = "[StartDate]"
lngView = acNormal 'Use acNormal to print instead of preview.


If Not IsNull(Me.txtStartDateFrom) Then
strWhere = strWhere & "([StartDate] >= " & Format(Me.txtStartDateFrom, strcJetDate) & ") AND" ' ") AND"
End If
'Debug.Print strWhere

If Not IsNull(Me.txtEndDateFrom) Then 'Less than the next day.
strWhere = strWhere & "([StartDate] <= " & Format(Me.txtEndDateFrom, strcJetDate) & ")AND " ' ") AND"
End If

'Date field example. Use the format string to add the # delimiters and get the right international format.
If Not IsNull(Me.txtStartDateFinish) Then
strWhere = strWhere & "([DateFinish] >= " & Format(Me.txtStartDateFinish, strcJetDate) & ") AND " '") AND "
End If

'Another date field example. Use "less than the next day" since this field has times as well as dates.
If Not IsNull(Me.txtEndDateFinish) Then 'Less than the next day.
strWhere = strWhere & "([DateFinish] <= " & Format(Me.txtEndDateFinish, strcJetDate) & ")" 'AND
Else
strWhere = strWhere & "([DateFinish] <= " & Nz([Forms]![frmSearchEngine]![txtEndDateFinish], #1/1/2100#) & ") " '#1/1/2100#
'<=Nz([Forms]![YourForm]![ToDate], [EndDate])
End If

'Debug.Print strWhere


'Check list boxes
With Me.ListEngineType 'lstDrugProduct
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strInDrug = strInDrug & """" & ListEngineType.ItemData(varItem) & """, "
End If
Next varItem
End With
'Debug.Print strInDrug

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

'Debug.Print strInDesc

lngLen1 = Len(strInDrug) - 2
If lngLen1 > 0 Then
strWhere = strWhere & " AND [EngineType] IN (" & Left$(strInDrug, lngLen1) & ")" 'DrugProduct & ")" AND
End If

lngLen2 = Len(strInDesc) - 2
If lngLen2 > 0 Then
strWhere = strWhere & " AND [ReparType] IN (" & Left$(strInDesc, lngLen2) & ")" ' strWhere & " AND
End If

' lngLen3 = Len(strInSilnikRem) - 2
'If lngLen3 > 0 Then
'strWhere = strInDrug & strInDesc
'End If
'Debug.Print strWhere

'lngLen4 = Len(strInDesc) - 2
'If lngLen2 > 0 Then
' strWhere = strWhere & " AND [ReparType] IN (" & Left$(strInDesc, lngLen2) & ")" ' strWhere & " AND
'End If

'Debug.Print strWhere
DoCmd.OpenForm strForm, acNormal, , strWhere
 

Users who are viewing this thread

Top Bottom