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