DATE OPTION IN VBA CODE

Joined
Mar 7, 2011
Messages
1
Reaction score
0
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
 
Last edited by a moderator:
Back
Top