I want to use a VBA code to pop up a warning message in the start of my database and tell me the name of people that their ages passed 50 just for once the last i could reach is that
For i = 1 To 4
If [Forms]![1]![years] >=50 Then
MsgBox "employees:" & Me.name
End If
Next i
You can use my simple function:
Public Function AgeSimple( _
ByVal datDateOfBirth As Date) _
As Integer
' Returns the difference in full years from datDateOfBirth to current date.
'
' Calculates correctly for:
' leap years
' dates of 29. February
' date/time values with embedded time values
'
' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of years to dates of Feb. 29.
' when the resulting year is a common year.
' After an idea of Markus G. Fischer.
'
' 2007-06-26. Cactus Data ApS, CPH.
Dim datToday As Date
Dim intAge As Integer
Dim intYears As Integer
datToday = Date
' Find difference in calendar years.
intYears = DateDiff("yyyy", datDateOfBirth, datToday)
If intYears > 0 Then
' Decrease by 1 if current date is earlier than birthday of current year
' using DateDiff to ignore a time portion of datDateOfBirth.
intAge = intYears - Abs(DateDiff("d", datToday, DateAdd("yyyy", intYears, datDateOfBirth)) > 0)
End If
AgeSimple = intAge
End Function
And a loop in the click event of a button on your form (example):
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
If rs.RecordCount > 0 Then
rs.MoveFirst
End If
While Not rs.EOF
If AgeSimple(Nz(rs!DOB.Value, Date)) >= 50 Then
MsgBox "Employee: " & rs![Name].Value, vbInformation + vbOKOnly, "50+"
End If
rs.MoveNext
Wend
Set rs = Nothing
Of course, replace the field/control names here with those of your actual form.
Edit
A demo is here
Related
I've tried this but it returns text15 = 09/12/2020 Result = 2eek, I actually need week 2.
=Format(DatePart("ww",[Text15])-DatePart("ww",DateSerial(Year([Text15]),Month([Text15]),1))+1,"Week ")
you are almost there, try this:
= "Week " & (DatePart("ww",[Text15])-DatePart("ww",DateSerial(Year([Text15]),Month([Text15]),1))) + 1
or this:
="Week " & Abs(Int(-DatePart("d",[Text15])/7))
You can use a method similar to the ISO 8601 numbering of weeks:
' Calculates the "weeknumber of the month" for a date.
' The value will be between 1 and 5.
'
' Numbering is similar to the ISO 8601 numbering having Monday
' as the first day of the week and the first week beginning
' with Thursday or later as week number 1.
' Thus, the first day of a month may belong to the last week
' of the previous month, having a week number of 4 or 5.
'
' 2020-09-23. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function WeekOfMonth( _
ByVal Date1 As Date) _
As Integer
Dim ThursdayInWeek As Date
Dim FirstThursday As Date
Dim WeekNumber As Integer
ThursdayInWeek = DateWeekdayInWeek(Date1, vbThursday, vbMonday)
FirstThursday = DateWeekdayInMonth(ThursdayInWeek, 1, vbThursday)
WeekNumber = 1 + DateDiff("ww", FirstThursday, Date1, vbMonday)
WeekOfMonth = WeekNumber
End Function
As you can see, a supporting function is used:
Option Explicit
Public Const DaysPerWeek As Long = 7
Public Const MaxWeekdayCountInMonth As Integer = 5
' Calculates the "weeknumber of the month" for a date.
' The value will be between 1 and 5.
'
' Numbering is similar to the ISO 8601 numbering having Monday
' as the first day of the week and the first week beginning
' with Thursday or later as week number 1.
' Thus, the first day of a month may belong to the last week
' of the previous month, having a week number of 4 or 5.
'
' 2020-09-23. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function WeekOfMonth( _
ByVal Date1 As Date) _
As Integer
Dim ThursdayInWeek As Date
Dim FirstThursday As Date
Dim WeekNumber As Integer
ThursdayInWeek = DateWeekdayInWeek(Date1, vbThursday)
FirstThursday = DateWeekdayInMonth(ThursdayInWeek, 1, vbThursday)
WeekNumber = 1 + DateDiff("ww", FirstThursday, Date1, vbMonday)
WeekOfMonth = WeekNumber
End Function
' Calculates the date of DayOfWeek in the week of DateInWeek.
' By default, the returned date is the first day in the week
' as defined by the current Windows settings.
'
' Optionally, parameter DayOfWeek can be specified to return
' any other weekday of the week.
' Further, parameter FirstDayOfWeek can be specified to select
' any other weekday as the first weekday of a week.
'
' Limitation:
' For the first and the last week of the range of Date, some
' combinations of DayOfWeek and FirstDayOfWeek that would result
' in dates outside the range of Date, will raise an overflow error.
'
' 2017-05-03. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateWeekdayInWeek( _
ByVal DateInWeek As Date, _
Optional ByVal DayOfWeek As VbDayOfWeek = VbDayOfWeek.vbUseSystemDayOfWeek, _
Optional ByVal FirstDayOfWeek As VbDayOfWeek = VbDayOfWeek.vbUseSystemDayOfWeek) _
As Date
Dim DayInWeek As VbDayOfWeek
Dim OffsetZero As Integer
Dim OffsetFind As Integer
Dim ResultDate As Date
' Find the date of DayOfWeek.
DayInWeek = Weekday(DateInWeek)
' Find the offset of the weekday of DateInWeek from the first day of the week.
' Will always be <= 0.
OffsetZero = (FirstDayOfWeek - DayInWeek - DaysPerWeek) Mod DaysPerWeek
' Find the offset of DayOfWeek from the first day of the week.
' Will always be >= 0.
OffsetFind = (DayOfWeek - FirstDayOfWeek + DaysPerWeek) Mod DaysPerWeek
' Calculate result date using the sum of the offset parts.
ResultDate = DateAdd("d", OffsetZero + OffsetFind, DateInWeek)
DateWeekdayInWeek = ResultDate
End Function
' Calculates the date of the occurrence of Weekday in the month of DateInMonth.
'
' If Occurrence is 0 or negative, the first occurrence of Weekday in the month is assumed.
' If Occurrence is 5 or larger, the last occurrence of Weekday in the month is assumed.
'
' If Weekday is invalid or not specified, the weekday of DateInMonth is used.
'
' 2019-12-08. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateWeekdayInMonth( _
ByVal DateInMonth As Date, _
Optional ByVal Occurrence As Integer, _
Optional ByVal Weekday As VbDayOfWeek = vbUseSystemDayOfWeek) _
As Date
Dim Offset As Integer
Dim Month As Integer
Dim Year As Integer
Dim ResultDate As Date
' Validate Weekday.
Select Case Weekday
Case _
vbMonday, _
vbTuesday, _
vbWednesday, _
vbThursday, _
vbFriday, _
vbSaturday, _
vbSunday
Case Else
' vbUseSystemDayOfWeek, zero, none or invalid value for VbDayOfWeek.
Weekday = VBA.Weekday(DateInMonth)
End Select
' Validate Occurence.
If Occurrence < 1 Then
' Find first occurrence.
Occurrence = 1
ElseIf Occurrence > MaxWeekdayCountInMonth Then
' Find last occurrence.
Occurrence = MaxWeekdayCountInMonth
End If
' Start date.
Month = VBA.Month(DateInMonth)
Year = VBA.Year(DateInMonth)
ResultDate = DateSerial(Year, Month, 1)
' Find offset of Weekday from first day of month.
Offset = DaysPerWeek * (Occurrence - 1) + (Weekday - VBA.Weekday(ResultDate) + DaysPerWeek) Mod DaysPerWeek
' Calculate result date.
ResultDate = DateAdd("d", Offset, ResultDate)
If Occurrence = MaxWeekdayCountInMonth Then
' The latest occurrency of Weekday is requested.
' Check if there really is a fifth occurrence of Weekday in this month.
If VBA.Month(ResultDate) <> Month Then
' There are only four occurrencies of Weekday in this month.
' Return the fourth as the latest.
ResultDate = DateAdd("d", -DaysPerWeek, ResultDate)
End If
End If
DateWeekdayInMonth = ResultDate
End Function
Watch an example output here.
I need to make a report in Access about how many overtime every employee has. Because some workes work from Mo-Th 10h and Fr 0h i cant say
Count everything above 8h .
Therefore I need all business days a month * 8h and compare it with actual working time which I Sum by month ( already working! )
Solution approach:
SELECT Format([TaetigkeitsDatum],"mmmm yy") AS Monat,
tbl_Taetigkeitserfassung.TaetigkeitsPersonalID,
Sum(tbl_Taetigkeitserfassung.TaetigkeitsStundenAnzeigen) AS SummevonTaetigkeitsStundenAnzeigen
FROM tbl_Taetigkeitserfassung
GROUP BY Format([TaetigkeitsDatum],"mmmm yy"),
tbl_Taetigkeitserfassung.TaetigkeitsPersonalID;
This shows me the formatted Month(TaetigkeitsDatum), the Employee(TaetigkeitsPersonalID) and the Sum of the Working Hours ( TaetigkeitsStundenAnzeigen).
But I dont know how to display the hours of Business days that month so I can compare and display overtime...
Expected Solution:
January 19: 23Days (without Weekend, holidays dont matter) * 8h = 184h
Working Time of Mr.X = 186h -> 2h Overtime
DateDiff isnt working, because I need 2 Dates for it to work and than there is the "only count business days" problem.
You can use this expression:
WorkDays: ISO_WorkdayDiff(DateSerial(Year([TaetigkeitsDatum]), Month([TaetigkeitsDatum]), 1), DateSerial(Year([TaetigkeitsDatum]), Month([TaetigkeitsDatum]) + 1, 1))
and a function like this:
Public Function ISO_WorkdayDiff( _
ByVal datDateFrom As Date, _
ByVal datDateTo As Date, _
Optional ByVal booExcludeHolidays As Boolean) _
As Long
' Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' May be freely used and distributed.
' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen
' 2000-10-03. Constants added.
' Option for 5 or 6 working days per week added.
' 2008-06-12. Option to exclude holidays from the count of workdays.
Const cbytWorkdaysOfWeek As Byte = 5
' Name of table with holidays.
Const cstrTableHoliday As String = "tblHoliday"
' Name of date field in holiday table.
Const cstrFieldHoliday As String = "HolidayDate"
Dim bytSunday As Byte
Dim intWeekdayDateFrom As Integer
Dim intWeekdayDateTo As Integer
Dim lngDays As Long
Dim datDateTemp As Date
Dim strDateFrom As String
Dim strDateTo As String
Dim lngHolidays As Long
Dim strFilter As String
' Reverse dates if these have been input reversed.
If datDateFrom > datDateTo Then
datDateTemp = datDateFrom
datDateFrom = datDateTo
datDateTo = datDateTemp
End If
' Find ISO weekday for Sunday.
bytSunday = Weekday(vbSunday, vbMonday)
' Find weekdays for the dates.
intWeekdayDateFrom = Weekday(datDateFrom, vbMonday)
intWeekdayDateTo = Weekday(datDateTo, vbMonday)
' Compensate weekdays' value for non-working days (weekends).
intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)
' Calculate number of working days between the two weekdays, ignoring number of weeks.
lngDays = intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
' Add number of working days between the weeks of the two dates.
lngDays = lngDays + (cbytWorkdaysOfWeek * DateDiff("w", datDateFrom, datDateTo, vbMonday, vbFirstFourDays))
If booExcludeHolidays And lngDays > 0 Then
strDateFrom = Format(datDateFrom, "yyyy\/mm\/dd")
strDateTo = Format(datDateTo, "yyyy\/mm\/dd")
strFilter = cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "# And Weekday(" & cstrFieldHoliday & ", 2) <= " & cbytWorkdaysOfWeek & ""
lngHolidays = DCount("*", cstrTableHoliday, strFilter)
End If
ISO_WorkdayDiff = lngDays - lngHolidays
End Function
I need help, because when I run de code, Error appears when some date field is empty. I have a table with information and I run this code since the generator.
Eliminate #Error when I run the code vba in ACCESS
I will grateful for you help.
Option Compare Database
Public Function WorkingDays2(FECHA_DE_VALIDACION_FA As Date, FECHA_IMPRESIÓN As Date) As Integer
'....................................................................
' Name: WorkingDays2
' Inputs: StartDate As Date
' EndDate As Date
' Returns: Integer
' Author: Arvin Meyer
' Date: May 5,2002
' Comment: Accepts two dates and returns the number of weekdays between them
' Note that this function has been modified to account for holidays. It requires a table
' named tblHolidays with a field named HolidayDate.
'....................................................................
Dim intCount As Integer
Dim rst As DAO.Recordset
Dim DB As DAO.Database
Set DB = CurrentDb
Set rst = DB.OpenRecordset("SELECT [DIAFESTIVO] FROM DIASFESTIVOS", dbOpenSnapshot)
'StartDate = StartDate + 1
'To count StartDate as the 1st day comment out the line above
intCount = 0
Do While FECHA_DE_VALIDACION_FA <= FECHA_IMPRESIÓN
rst.FindFirst "[DIAFESTIVO] = #" & FECHA_DE_VALIDACION_FA & "#"
If Weekday(FECHA_DE_VALIDACION_FA) <> vbSunday And Weekday(FECHA_DE_VALIDACION_FA) <> vbSaturday Then
If rst.NoMatch Then intCount = intCount + 1
End If
FECHA_DE_VALIDACION_FA = FECHA_DE_VALIDACION_FA + 1
Loop
WorkingDays2 = intCount
Exit_WorkingDays2:
Exit Function
WorkingDays2 = intCount
Exit_WorkingDays2:
Exit Function
Err_WorkingDays2:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_WorkingDays2
End Select
End Function
It depends a bit where you are calling this function from within your database. Probably as a calculated field in a query? Something like this:
WorkingDays: WorkingDays3([YourDateField])?
Try this instead:
WorkingDays: WorkingDays3(Nz([YourDateField],Date())
Your original question included code for a function named WorkingDays3, which takes one date parameter.
Your illustration shows a function named WorkingDays2, which takes two date parameters.
I think you will need to give more detailed information about the data you are working with, and under which conditions you are seeing the #Error.
I'm using the expression builder to give me a calculated value. It looks like this:
=DateDiff("w",Date(),[Latest_Call_Date])
However, this is giving me results as if it were doing a calculation based on weeks instead of days minus weekends . When I try the same function, but with the interval set to days (d) instead of weekdays (w) I get the expected results (but of course, including Saturdays and Sundays, which I do not wish to include in the calculation). So, for example, for everyday this week I'm getting 1,2,3,4,5 day differences but they all return zero with weekdays. That formula is:
=DateDiff("d",Date(),[Latest_Call_Date])
Is there something else I have to do to get "weekdays" interval to work?
I'm using Access 2013, in an .accdb file format.
Weekdays excluding weekends (and holidays) are usually labelled workdays.
DateDiff("w", ..) returns the count of a weekday between two dates, while
DateDiff("ww", ..) returns the difference in calendar weeks between two dates.
Counting workdays takes a little more. This function will do:
Public Function DateDiffWorkdays( _
ByVal datDate1 As Date, _
ByVal datDate2 As Date, _
Optional ByVal booWorkOnHolidays As Boolean) _
As Long
' Calculates the count of workdays between datDate1 and datDate2.
' 2014-10-03. Cactus Data ApS, CPH
Dim aHolidays() As Date
Dim lngDiff As Long
Dim lngSign As Long
Dim lngHoliday As Long
lngSign = Sgn(DateDiff("d", datDate1, datDate2))
If lngSign <> 0 Then
If booWorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between datDate1 and datDate2.
aHolidays = GetHolidays(datDate1, datDate2)
End If
Do Until DateDiff("d", datDate1, datDate2) = 0
Select Case Weekday(datDate1)
Case vbSaturday, vbSunday
' Skip weekend.
Case Else
' Check for holidays to skip.
' Ignore error when using LBound and UBound on an unassigned array.
On Error Resume Next
For lngHoliday = LBound(aHolidays) To UBound(aHolidays)
If Err.Number > 0 Then
' No holidays between datDate1 and datDate2.
ElseIf DateDiff("d", datDate1, aHolidays(lngHoliday)) = 0 Then
' This datDate1 hits a holiday.
' Subtract one day before adding one after the loop.
lngDiff = lngDiff - lngSign
Exit For
End If
Next
On Error GoTo 0
lngDiff = lngDiff + lngSign
End Select
datDate1 = DateAdd("d", lngSign, datDate1)
Loop
End If
DateDiffWorkdays = lngDiff
End Function
And the Holidays, should you need it some day:
Public Function GetHolidays( _
ByVal datDate1 As Date, _
ByVal datDate2 As Date, _
Optional ByVal booDesc As Boolean) _
As Date()
' Finds the count of holidays between datDate1 and datDate2.
' The holidays are returned as an array of dates.
' DAO objects are declared static to speed up repeated calls with identical date parameters.
' 2014-10-03. Cactus Data ApS, CPH
' The table that holds the holidays.
Const cstrTable As String = "tblHoliday"
' The field of the table that holds the dates of the holidays.
Const cstrField As String = "HolidayDate"
' Constants for the arrays.
Const clngDimRecordCount As Long = 2
Const clngDimFieldOne As Long = 0
Static dbs As DAO.Database
Static rst As DAO.Recordset
Static datDate1Last As Date
Static datDate2Last As Date
Dim adatDays() As Date
Dim avarDays As Variant
Dim strSQL As String
Dim strDate1 As String
Dim strDate2 As String
Dim strOrder As String
Dim lngDays As Long
If DateDiff("d", datDate1, datDate1Last) <> 0 Or DateDiff("d", datDate2, datDate2Last) <> 0 Then
' datDate1 or datDate2 has changed since the last call.
strDate1 = Format(datDate1, "\#yyyy\/mm\/dd\#")
strDate2 = Format(datDate2, "\#yyyy\/mm\/dd\#")
strOrder = Format(booDesc, "\A\s\c;\D\e\s\c")
strSQL = "Select " & cstrField & " From " & cstrTable & " " & _
"Where " & cstrField & " Between " & strDate1 & " And " & strDate2 & " " & _
"Order By 1 " & strOrder
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
' Save the current set of date parameters.
datDate1Last = datDate1
datDate2Last = datDate2
End If
lngDays = rst.RecordCount
If lngDays = 0 Then
' Leave adatDays() as an unassigned array.
Else
ReDim adatDays(lngDays - 1)
' As repeated calls may happen, do a movefirst.
rst.MoveFirst
avarDays = rst.GetRows(lngDays)
' rst is now positioned at the last record.
For lngDays = LBound(avarDays, clngDimRecordCount) To UBound(avarDays, clngDimRecordCount)
adatDays(lngDays) = avarDays(clngDimFieldOne, lngDays)
Next
End If
' DAO objects are static.
' Set rst = Nothing
' Set dbs = Nothing
GetHolidays = adatDays()
End Function
looking for some access query help.
Im trying to make a total hours worked in a week query.
TotalHours: (([FinishAM]-[StartAM]+[FinishPM]-[StartPM])*24 & " Hours")
Here's the query for the daily hours worked..
Im quite new to access.
cheers.
You can use:
' Specify begin and end time of daily working hours.
Const cdatWorkTimeStart As Date = #8:00:00 AM#
Const cdatWorkTimeStop As Date = #4:00:00 PM#
Const cbytWorkdaysOfWeek As Byte = 5
Dim TotalHours As Integer
TotalHours = DateDiff("h", cdatWorkTimeStart, cdatWorkTimeStop) * cbytWorkdaysOfWeek
For an extended count of hours for any count of days, you can use the full function here:
Public Function ISO_WorkTimeDiff( _
ByVal datDateTimeFrom As Date, _
ByVal datDateTimeTo As Date, _
Optional ByVal booNoHours As Boolean) _
As Long
' Purpose: Calculate number of working minutes between date/times datDateTimeFrom and datDateTimeTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' Returns: "Working minutes". Divide by 60 to obtain working hours.
' Limitation: Does not count for public holidays.
'
' May be freely used and distributed.
' 2001-06-26. Gustav Brock, Cactus Data ApS, Copenhagen
'
' If booNoHours is True, time values are ignored.
' Specify begin and end time of daily working hours.
Const cdatWorkTimeStart As Date = #8:00:00 AM#
Const cdatWorkTimeStop As Date = #4:00:00 PM#
Const cbytWorkdaysOfWeek As Byte = 5
Dim bytSunday As Byte
Dim intWeekdayDateFrom As Integer
Dim intWeekdayDateTo As Integer
Dim datTimeFrom As Date
Dim datTimeTo As Date
Dim lngDays As Long
Dim lngMinutes As Long
Dim lngWorkMinutesDaily As Long
' No special error handling.
On Error Resume Next
If DateDiff("n", datDateTimeFrom, datDateTimeTo) <= 0 Then
' Nothing to do. Return zero.
Else
' Calculate number of daily "working minutes".
lngWorkMinutesDaily = DateDiff("n", cdatWorkTimeStart, cdatWorkTimeStop)
' Find ISO weekday for Sunday.
bytSunday = Weekday(vbSunday, vbMonday)
' Find weekdays for the dates.
intWeekdayDateFrom = Weekday(datDateTimeFrom, vbMonday)
intWeekdayDateTo = Weekday(datDateTimeTo, vbMonday)
' Compensate weekdays' value for non-working days (weekends).
intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)
' Calculate number of working days between the weeks of the two dates.
lngDays = (cbytWorkdaysOfWeek * DateDiff("w", datDateTimeFrom, datDateTimeTo, vbMonday, vbFirstFourDays))
' Add number of working days between the two weekdays, ignoring number of weeks.
lngDays = lngDays + intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
If Not booNoHours = True Then
' Extract begin and stop hour (time) for the working period.
datTimeFrom = TimeSerial(Hour(datDateTimeFrom), Minute(datDateTimeFrom), Second(datDateTimeFrom))
datTimeTo = TimeSerial(Hour(datDateTimeTo), Minute(datDateTimeTo), Second(datDateTimeTo))
' Adjust times before or after daily working hours to boundaries of working hours.
If DateDiff("n", datTimeFrom, cdatWorkTimeStart) > 0 Then
datTimeFrom = cdatWorkTimeStart
ElseIf DateDiff("n", datTimeFrom, cdatWorkTimeStop) < 0 Then
datTimeFrom = cdatWorkTimeStop
End If
If DateDiff("n", datTimeTo, cdatWorkTimeStart) > 0 Then
datTimeTo = cdatWorkTimeStart
ElseIf DateDiff("n", datTimeTo, cdatWorkTimeStop) < 0 Then
datTimeTo = cdatWorkTimeStop
End If
' Calculate number of working minutes between the two days, ignoring number of days.
lngMinutes = DateDiff("n", datTimeFrom, datTimeTo)
End If
' Calculate number of working minutes between the two days using the workday count.
lngMinutes = lngMinutes + (lngDays * lngWorkMinutesDaily)
End If
ISO_WorkTimeDiff = lngMinutes
End Function