HI
I HAVE BUILT A ACCESS FORM WITH 04COMBOS FOR FILTERING DATA
ON A SUBFORM. GOT CODE FROM THE NET. MY PROBLEM IS IT HAS
NO DATE OPTION.
PLS SOMEONE HELP TO INSERT STARAT DATE AND END DATE OPTION IN THIS
CODE.
THANKS A LOT
KINDLY NOTE MY EMAIL ADDRESS
VBA CODE IS as under:-
Option Compare Database
Option Explicit
Dim CurrentFilter As String
Private Sub RemoveFiltersBut_Click()
Dim Ctrl As Control
For Each Ctrl In Me.Controls
If Ctrl.ControlType = acComboBox Then Ctrl = Null
Next Ctrl
CurrentFilter = ""
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.Filter = ""
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.FilterOn = False
End Sub
Private Function StockSearch()
On Error GoTo Error_StockSearch
Dim FilterClause As String, D As Long
D = Me.DirectionGrp.Value
If Nz(Me.Grade.Column(0), 0) > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Grade]='" & Me.Grade.Value & "'"
End If
If Nz(Me.Treatment.Column(0), 0) > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Treatment]='" & Me.Treatment.Value & "'"
End If
If Len(Me.Drying.Value & "") > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Drying]='" & Me.Drying.Value & "'"
End If
If Len(Me.Finish.Value & "") > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Finish]='" & Me.Finish.Value & "'"
End If
'Fill this Form wide variable so that it can be used for
'the Report.
CurrentFilter = FilterClause: FilterClause = ""
'Place our created Filter Criteria into the Filter property of SubForm.
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.Filter = CurrentFilter
'Turn on the Filter
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.FilterOn = True
Exit_StockSearch:
Exit Function
Error_StockSearch:
MsgBox "StockSearch Function Error" & vbCr & vbCr & _
Err.Number & " - " & Err.Description, vbExclamation, _
"Stock Search Error"
Resume Exit_StockSearch
End Function
Private Sub StockReportBut_Click()
On Error GoTo Err_StockReport_Click
DoCmd.OpenReport "Stock Filter Report", acPreview, , CurrentFilter
Exit_StockReport_Click:
Exit Sub
Err_StockReport_Click:
MsgBox Err.Description
Resume Exit_StockReport_Click
End Sub
Private Function ClearCtrl(Ctrl As Control)
Ctrl = Null
Call StockSearch
End Function
I HAVE BUILT A ACCESS FORM WITH 04COMBOS FOR FILTERING DATA
ON A SUBFORM. GOT CODE FROM THE NET. MY PROBLEM IS IT HAS
NO DATE OPTION.
PLS SOMEONE HELP TO INSERT STARAT DATE AND END DATE OPTION IN THIS
CODE.
THANKS A LOT
KINDLY NOTE MY EMAIL ADDRESS
VBA CODE IS as under:-
Option Compare Database
Option Explicit
Dim CurrentFilter As String
Private Sub RemoveFiltersBut_Click()
Dim Ctrl As Control
For Each Ctrl In Me.Controls
If Ctrl.ControlType = acComboBox Then Ctrl = Null
Next Ctrl
CurrentFilter = ""
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.Filter = ""
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.FilterOn = False
End Sub
Private Function StockSearch()
On Error GoTo Error_StockSearch
Dim FilterClause As String, D As Long
D = Me.DirectionGrp.Value
If Nz(Me.Grade.Column(0), 0) > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Grade]='" & Me.Grade.Value & "'"
End If
If Nz(Me.Treatment.Column(0), 0) > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Treatment]='" & Me.Treatment.Value & "'"
End If
If Len(Me.Drying.Value & "") > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Drying]='" & Me.Drying.Value & "'"
End If
If Len(Me.Finish.Value & "") > 0 Then
If FilterClause <> "" Then FilterClause = FilterClause & IIf(D = 1, " AND ", " OR ")
FilterClause = FilterClause & "[Finish]='" & Me.Finish.Value & "'"
End If
'Fill this Form wide variable so that it can be used for
'the Report.
CurrentFilter = FilterClause: FilterClause = ""
'Place our created Filter Criteria into the Filter property of SubForm.
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.Filter = CurrentFilter
'Turn on the Filter
Forms("Stock Filter")("Packet Volumes Query Form Search subform").Form.FilterOn = True
Exit_StockSearch:
Exit Function
Error_StockSearch:
MsgBox "StockSearch Function Error" & vbCr & vbCr & _
Err.Number & " - " & Err.Description, vbExclamation, _
"Stock Search Error"
Resume Exit_StockSearch
End Function
Private Sub StockReportBut_Click()
On Error GoTo Err_StockReport_Click
DoCmd.OpenReport "Stock Filter Report", acPreview, , CurrentFilter
Exit_StockReport_Click:
Exit Sub
Err_StockReport_Click:
MsgBox Err.Description
Resume Exit_StockReport_Click
End Sub
Private Function ClearCtrl(Ctrl As Control)
Ctrl = Null
Call StockSearch
End Function
Last edited by a moderator: