Filter Form From ComboBox and date field (1 Viewer)

[theinviter]

Dears;

I Have created a Form " 6-Inventory_Data" and on the top of the form added 2 Combo box and 2 fields for date selection, once I applied below code it did not work.
can you please guide me;

Private Sub filterThisForm8()
Dim S1, S2
On Error GoTo errhandler
'n = 1 / 0 ' cause an error
S1 = ""
If Len(Me!Combo_Category & "") <> 0 Then
S1 = S1 & " and [Category] Like '*" & Me!Combo_Category & "*' "
End If

If Len(Me!Combo_Items & "") <> 0 Then
S1 = S1 & " and [Items] Like '*" & Me!Combo_Items & "*' "
End If

If Len(Me!Combo101 & "") <> 0 Then
S1 = S1 & " and [Date_] >= #" & Format(Nz(Me.Date_From, 1), "yyyy\/mm\/dd") & "# AND [Date_] <= #" & Format(Nz(Me.Date_To, 2958465), "yyyy\/mm\/dd")
End If



If Len(S1) > 5 Then
S1 = Mid(S1, 5)
With Me.Form
.Filter = S1
.FilterOn = True
End With

Else
Me.Form.FilterOn = False
End If

Exit Sub
errhandler:
' error handling code
Resume Next
End Sub

 

[Josef P.]

What does the filter expression look like?

If Len(S1) > 5 Then
       S1 = Mid(S1, 5)

       debug.print S1
       stop ' check filter string in immediate window

       With Me.Form
           .Filter = S1
           .FilterOn = True
       End With
...

The closing # character is missing from the last date.

S1 = S1 & " and [Date_] >= #" & Format(Nz(Me.Date_From, 1), "yyyy\/mm\/dd") & "#" & _
                          " AND [Date_] <= #" & Format(Nz(Me.Date_To, 2958465), "yyyy\/mm\/dd") & "#" '<---

Is the date format used correctly converted by Jet/ACE? (I usually use yyyy-mm-dd or mm\/dd\/yyyy.)
Tip: use a function to build the sql string for a date.
e. g.:

public function DateToSqlString(byval DateValue as Date) as String
   DateToSqlString = Format(DateValue, "\#yyyy-mm-dd\#")
end Function

=>

S1 = S1 & " and [Date_] >= " & DateToSqlString(Nz(Me.Date_From, 1)) & _
                          " AND [Date_] <= " & DateToSqlString(Nz(Me.Date_To, 2958465))

[OT: Code]
If Len(Me!Combo_Category & "") <> 0 Then
When is the length of a string less than 0?

Dim S1 as String
vs.
Dim FilterString as String

I would avoid short, meaningless variable names to improve readability. You read code more often than you write it.

 

[theinviter]

What does the filter expression look like?

If Len(S1) > 5 Then
       S1 = Mid(S1, 5)

       debug.print S1
       stop ' check filter string in immediate window

       With Me.Form
           .Filter = S1
           .FilterOn = True
       End With
...

The closing # character is missing from the last date.

S1 = S1 & " and [Date_] >= #" & Format(Nz(Me.Date_From, 1), "yyyy\/mm\/dd") & "#" & _
                          " AND [Date_] <= #" & Format(Nz(Me.Date_To, 2958465), "yyyy\/mm\/dd") & "#" '<---

Is the date format used correctly converted by Jet/ACE? (I usually use yyyy-mm-dd or mm\/dd\/yyyy.)
Tip: use a function to build date string.
e. g.:

public function DateToSqlText(byval DateValue as Date) as String
   DateToSqlText = Format(DateValue, "\#yyyy-mm-dd\#")
end Function

=>

S1 = S1 & " and [Date_] >= " & DateToSqlText(Nz(Me.Date_From, 1)) & _
                          " AND [Date_] <= " & DateToSqlText(Nz(Me.Date_To, 2958465))

[OT: Code]
If Len(Me!Combo_Category & "") <> 0 Then
When is the length of a string less than 0?

Dim S1 as String
vs.
Dim FilterString as String

I would avoid short, meaningless variable names to improve readability. You read code more often than you write it.

am not sure about string length. can you advise and help to write all code.

 

[Josef P.]

What does the filter expression (output with Debug.Print) look like?

For my understanding:

If Len(Me!Combo_Category & "") <> 0 Then
       S1 = S1 & " and [Category] Like  '*" & Me!Combo_Category & "*'  "
   End If

You select a value from a combo box. Why does this value still have to be masked as a filter for Category with "*"?

 

[Josef P.]

For the fun of refactoring, the creation of the code shown below in several steps (see appendix).

There are already ready-made codemodules that help to generate the filter expression. (Search for FAYT or have a look at FilterStringBuilder and/or SqlTools - and there are certainly other solutions)
The code shown below is only intended to show one possibility. and the refactoring process.
The code is not intended to be considered "finished".

Preliminary result (can be further improved):

Private Sub filterThisForm8()

    Dim FilterString As String

On Error Goto errhandler

' 1. Build criteria string
    FilterString = GetFilterString()
    Debug.Print FilterString
    Stop ' check filter string in immediate window

' 2. Apply filter
    ApplyFilter Me, FilterString

Exit Sub
errhandler:
' error handling code
    Resume Next '<--- Why?

End Sub

Private Function GetFilterString() As String

    Dim FilterString As String

    AppendCriteria FilterString, BuildSqlCriteria("[Category]", "Like", SQL_Text, Me!Combo_Category.Value, SQL_WildCardLeft + SQL_WildCardRight)
    AppendCriteria FilterString, BuildSqlCriteria"[Items]", "Like", SQL_Text, Me!Combo_Items.Value, SQL_WildCardLeft + SQL_WildCardRight)

    AppendCriteria FilterString, BuildSqlCriteria("[Date_]", ">=", SQL_Date, Me!Date_From.Value)
    AppendCriteria FilterString, BuildSqlCriteria("[Date_]", "<=", SQL_Date, Me!Date_To.Value)

    GetFilterString = FilterString

End Function

Private Sub ApplyFilter(ByVal FormRef As Form, ByVal FilterString As String)

    With FormRef
        .Filter = FilterString
        .FilterOn = (Len(FilterString)>0)
    End With

End Sub

'######################################################
'
' use new codemodule for this code:
'
Option Compare Text
Option Explicit

Public Enum SqlFieldDataType
   SQL_Boolean = 1
   SQL_Numeric = 2
   SQL_Text = 3
   SQL_Date = 4
End Enum

Public Enum SqlStringWildCard
   SQL_WildCardNone = 0
   SQL_WildCardLeft = 1
   SQL_WildCardRight = 2
End Enum

Public Sub AppendCriteria(ByRef CriteriaString As String, ByVal CriteriaStringToAppend As String)

    If Len(CriteriaStringToAppend) = 0 Then
        Exit Sub
    End If

    If Len(CriteriaString) > 0 Then
        CriteriaString = CriteriaString & " and "
    End If

    CriteriaString = CriteriaString & CriteriaStringToAppend

End Sub

Public Function BuildSqlCriteria(ByVal FieldName As String, ByVal Operator As String, ByVal DataType As SqlFieldDataType, ByVal FilterValue As String, Optional ByVal UseWildCard As SqlStringWildCard = 0) As String

    If IsNull(FilterValue) Then
       Exit Function
    End If

    BuildSqlCriteria = FieldName & " " & Operator & " " & GetSqlCriteriaValue(DataType, FilterValue, UseWildCard)

End Function

Private Function GetSqlCriteriaValue(ByVal DataType As SqlFieldDataType, ByVal FilterValue As String, ByVal UseWildCard As SqlStringWildCard) As String

    Dim SqlCriteriaValue As String

    Select Case DataType
        Case SQL_Text
            If (UseWildCard And SQL_WildCardLeft) = SQL_WildCardLeft Then
                FilterValue = "*" & FilterValue
            End If
            If (UseWildCard And SQL_WildCardRight) = SQL_WildCardRight Then
                FilterValue = FilterValue & "*"
            End If
            SqlCriteriaValue = TextToSqlText(FilterValue)
        Case SQL_Date
            SqlCriteriaValue = DateToSqlText(FilterValue)
        Case Else
            err.Raise vbObjectError, "GetSqlCriteriaValue", "Not implemented"
    End Select

    GetSqlCriteriaValue = SqlCriteriaValue

End Function

Public Function TextToSqlText(ByVal Value As String) As String

   TextToSqlText = "'" & Replace$(Value, "'", "''") & "'"

End Function

Public Function DateToSqlText(ByVal Value As Date) As String

   DateToSqlText = Format(Value, "\#yyyy-mm-dd\#")

End Function