Hello!
Can someone help me with this code:
i want to create a filter for my report, when click print it will filter date 21 previous month to 20 current month (example: 21 january - 20 february). The start date in reports should be 21 previous month to current.
Option Compare Database
' Handles the month filter change
Private Sub cboMonthFilter_AfterUpdate()
Dim selectedMonth As Integer
Dim filterCriteria As String
On Error GoTo ErrHandler
' Check if "All" is selected and clear only the month filter
If Me.cboMonthFilter = "All" Then
ApplyFilters
MsgBox "Month filter cleared. Showing all records for EmpNo: " & Me.EmpNo, vbInformation
Exit Sub
End If
' Check if a valid month is selected
If IsNull(Me.cboMonthFilter) Or Me.cboMonthFilter = "" Then
Me.FilterOn = False
MsgBox "Filter cleared.", vbInformation
Exit Sub
End If
' Convert the selected month name to a month number
selectedMonth = MonthNameToNumber(Me.cboMonthFilter.Value)
' Apply filters
ApplyFilters
Exit Sub
ErrHandler:
MsgBox "An error occurred: " & Err.Description, vbCritical
End Sub
' Handles the year filter change
Private Sub cboYearFilter_AfterUpdate()
On Error Resume Next
ApplyFilters
End Sub
Private Sub ApplyFilters()
Dim filterCriteria As String
Dim selectedMonth As Integer
Dim selectedYear As String
Dim recordCount As Integer
Dim empNumber As String
' Store the current EmpNo before applying the filter
empNumber = Nz(Me.EmpNo, "")
' Ensure EmpNo is not empty
If empNumber = "" Then
MsgBox "No Employee Number found!", vbExclamation
Exit Sub
End If
' Start with a base filter for EmpNo
filterCriteria = "EmpNo = '" & empNumber & "' AND Not IsNull([CheckInTime]) AND Not IsNull([CheckOutTime])"
' Handle year filter
If Not IsNull(Me.cboYearFilter) And Me.cboYearFilter <> "All" Then
filterCriteria = filterCriteria & " AND Year([Date]) = " & Me.cboYearFilter
End If
' Handle month filter
If Not IsNull(Me.cboMonthFilter) And Me.cboMonthFilter <> "All" Then
selectedMonth = MonthNameToNumber(Me.cboMonthFilter.Value)
filterCriteria = filterCriteria & " AND Month([Date]) = " & selectedMonth
End If
' Apply the filter
Me.Filter = filterCriteria
Me.FilterOn = True
' Check the number of records
recordCount = Me.Recordset.recordCount
' If no records are found, keep only the EmpNo filter and prevent empty dataset issue
If recordCount = 0 Then
MsgBox "There are no overtime records.", vbExclamation, "No Records Found"
' Restore only the EmpNo filter
Me.Filter = "EmpNo = '" & empNumber & "' AND Not IsNull([CheckInTime]) AND Not IsNull([CheckOutTime])"
Me.FilterOn = True
' Move to the first record to ensure form does not appear empty
If Not Me.Recordset.EOF Then
Me.Recordset.MoveFirst
End If
End If
End Sub
' Convert month name to month number
Private Function MonthNameToNumber(monthName As String) As Integer
Select Case monthName
Case "January": MonthNameToNumber = 1
Case "February": MonthNameToNumber = 2
Case "March": MonthNameToNumber = 3
Case "April": MonthNameToNumber = 4
Case "May": MonthNameToNumber = 5
Case "June": MonthNameToNumber = 6
Case "July": MonthNameToNumber = 7
Case "August": MonthNameToNumber = 8
Case "September": MonthNameToNumber = 9
Case "October": MonthNameToNumber = 10
Case "November": MonthNameToNumber = 11
Case "December": MonthNameToNumber = 12
Case Else: MonthNameToNumber = 0
End Select
End Function
Private Sub cmdPrint_Click()
Dim filterCriteria As String
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
Dim prevMonth As Integer
Dim prevYear As Integer
On Error GoTo ErrHandler
' Get the current date
currentDate = Date
' Determine start and end date for filtering
If Day(currentDate) >= 21 Then
' If the current day is 21 or later, set startDate to the 21st of the previous month
startDate = DateSerial(Year(currentDate), Month(currentDate) - 1, 21)
endDate = DateSerial(Year(currentDate), Month(currentDate), 20)
Else
' If the current day is before the 21st, set startDate to the 21st of two months ago
prevMonth = Month(currentDate) - 2
prevYear = Year(currentDate)
If prevMonth <= 0 Then
prevMonth = prevMonth + 12
prevYear = prevYear - 1
End If
startDate = DateSerial(prevYear, prevMonth, 21)
endDate = DateSerial(Year(currentDate), Month(currentDate) - 1, 20)
End If
' Construct filter criteria with properly formatted dates
filterCriteria = "[CheckInTime] >= #" & Format(startDate, "mm/dd/yyyy") & "# AND [CheckInTime] <= #" & Format(endDate, "mm/dd/yyyy") & "#"
' Open the "OvertimeRecords" report with the current filter
DoCmd.OpenReport "OvertimeRecords", acViewPreview, , filterCriteria
Exit Sub
ErrHandler:
MsgBox "An error occurred while trying to print: " & Err.Description, vbCritical
End Sub
Can someone help me with this code:
i want to create a filter for my report, when click print it will filter date 21 previous month to 20 current month (example: 21 january - 20 february). The start date in reports should be 21 previous month to current.
Option Compare Database
' Handles the month filter change
Private Sub cboMonthFilter_AfterUpdate()
Dim selectedMonth As Integer
Dim filterCriteria As String
On Error GoTo ErrHandler
' Check if "All" is selected and clear only the month filter
If Me.cboMonthFilter = "All" Then
ApplyFilters
MsgBox "Month filter cleared. Showing all records for EmpNo: " & Me.EmpNo, vbInformation
Exit Sub
End If
' Check if a valid month is selected
If IsNull(Me.cboMonthFilter) Or Me.cboMonthFilter = "" Then
Me.FilterOn = False
MsgBox "Filter cleared.", vbInformation
Exit Sub
End If
' Convert the selected month name to a month number
selectedMonth = MonthNameToNumber(Me.cboMonthFilter.Value)
' Apply filters
ApplyFilters
Exit Sub
ErrHandler:
MsgBox "An error occurred: " & Err.Description, vbCritical
End Sub
' Handles the year filter change
Private Sub cboYearFilter_AfterUpdate()
On Error Resume Next
ApplyFilters
End Sub
Private Sub ApplyFilters()
Dim filterCriteria As String
Dim selectedMonth As Integer
Dim selectedYear As String
Dim recordCount As Integer
Dim empNumber As String
' Store the current EmpNo before applying the filter
empNumber = Nz(Me.EmpNo, "")
' Ensure EmpNo is not empty
If empNumber = "" Then
MsgBox "No Employee Number found!", vbExclamation
Exit Sub
End If
' Start with a base filter for EmpNo
filterCriteria = "EmpNo = '" & empNumber & "' AND Not IsNull([CheckInTime]) AND Not IsNull([CheckOutTime])"
' Handle year filter
If Not IsNull(Me.cboYearFilter) And Me.cboYearFilter <> "All" Then
filterCriteria = filterCriteria & " AND Year([Date]) = " & Me.cboYearFilter
End If
' Handle month filter
If Not IsNull(Me.cboMonthFilter) And Me.cboMonthFilter <> "All" Then
selectedMonth = MonthNameToNumber(Me.cboMonthFilter.Value)
filterCriteria = filterCriteria & " AND Month([Date]) = " & selectedMonth
End If
' Apply the filter
Me.Filter = filterCriteria
Me.FilterOn = True
' Check the number of records
recordCount = Me.Recordset.recordCount
' If no records are found, keep only the EmpNo filter and prevent empty dataset issue
If recordCount = 0 Then
MsgBox "There are no overtime records.", vbExclamation, "No Records Found"
' Restore only the EmpNo filter
Me.Filter = "EmpNo = '" & empNumber & "' AND Not IsNull([CheckInTime]) AND Not IsNull([CheckOutTime])"
Me.FilterOn = True
' Move to the first record to ensure form does not appear empty
If Not Me.Recordset.EOF Then
Me.Recordset.MoveFirst
End If
End If
End Sub
' Convert month name to month number
Private Function MonthNameToNumber(monthName As String) As Integer
Select Case monthName
Case "January": MonthNameToNumber = 1
Case "February": MonthNameToNumber = 2
Case "March": MonthNameToNumber = 3
Case "April": MonthNameToNumber = 4
Case "May": MonthNameToNumber = 5
Case "June": MonthNameToNumber = 6
Case "July": MonthNameToNumber = 7
Case "August": MonthNameToNumber = 8
Case "September": MonthNameToNumber = 9
Case "October": MonthNameToNumber = 10
Case "November": MonthNameToNumber = 11
Case "December": MonthNameToNumber = 12
Case Else: MonthNameToNumber = 0
End Select
End Function
Private Sub cmdPrint_Click()
Dim filterCriteria As String
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
Dim prevMonth As Integer
Dim prevYear As Integer
On Error GoTo ErrHandler
' Get the current date
currentDate = Date
' Determine start and end date for filtering
If Day(currentDate) >= 21 Then
' If the current day is 21 or later, set startDate to the 21st of the previous month
startDate = DateSerial(Year(currentDate), Month(currentDate) - 1, 21)
endDate = DateSerial(Year(currentDate), Month(currentDate), 20)
Else
' If the current day is before the 21st, set startDate to the 21st of two months ago
prevMonth = Month(currentDate) - 2
prevYear = Year(currentDate)
If prevMonth <= 0 Then
prevMonth = prevMonth + 12
prevYear = prevYear - 1
End If
startDate = DateSerial(prevYear, prevMonth, 21)
endDate = DateSerial(Year(currentDate), Month(currentDate) - 1, 20)
End If
' Construct filter criteria with properly formatted dates
filterCriteria = "[CheckInTime] >= #" & Format(startDate, "mm/dd/yyyy") & "# AND [CheckInTime] <= #" & Format(endDate, "mm/dd/yyyy") & "#"
' Open the "OvertimeRecords" report with the current filter
DoCmd.OpenReport "OvertimeRecords", acViewPreview, , filterCriteria
Exit Sub
ErrHandler:
MsgBox "An error occurred while trying to print: " & Err.Description, vbCritical
End Sub
Last edited: