Working Days - Need Help modifying the formula (1 Viewer)

[rmulder]

So when I made an access 2007 program to track time off at our company, everything worked. Only issue is, I need to account for different employee's schedules. Some employees work mon-fri. Others work mon, wed, fri, sat, etc. So my best thought to add this ability is to add to each employee record 7 yes/no fields for sunday-saturday and check them accordingly. Now all my calculations start with the formula WorkDays which is as follows...

Public Function WorkDays(ByRef startDate As Date, _
     ByRef endDate As Date, _
     Optional ByRef strHolidays As String = "Holidays" _
     ) As Integer
    ' Returns the number of workdays between startDate
    ' and endDate inclusive.  Workdays excludes weekends and
    ' holidays. Optionally, pass this function the name of a table
    ' or query as the third argument. If you don't the default
    ' is "Holidays".
    On Error GoTo Workdays_Error
    Dim nWeekdays As Integer
    Dim nHolidays As Integer
    Dim strWhere As String
    
    ' DateValue returns the date part only.
    startDate = DateValue(startDate)
    endDate = DateValue(endDate)
    
    nWeekdays = Weekdays(startDate, endDate)
    If nWeekdays = -1 Then
        WorkDays = -1
        GoTo Workdays_Exit
    End If
    
    strWhere = "[Holiday] >= #" & startDate _
        & "# AND [Holiday] <= #" & endDate & "#"
    
    ' Count the number of holidays.
    nHolidays = DCount(Expr:="[Holiday]", _
        Domain:=strHolidays, _
        Criteria:=strWhere)
    
        WorkDays = nWeekdays - nHolidays
    
Workdays_Exit:
    Exit Function
    
Workdays_Error:
    WorkDays = -1
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
        vbCritical, "Workdays"
    Resume Workdays_Exit
    
End Function

It works in conjunction with the Weekdays function which is...

Public Function Weekdays(ByRef startDate As Date, _
    ByRef endDate As Date _
    ) As Integer
    ' Returns the number of weekdays in the period from startDate
    ' to endDate inclusive. Returns -1 if an error occurs.
    ' If your weekend days do not include Saturday and Sunday and
    ' do not total two per week in number, this function will
    ' require modification.
    On Error GoTo Weekdays_Error
    
    ' The number of weekend days per week.
    Const ncNumberOfWeekendDays As Integer = 2
    
    ' The number of days inclusive.
    Dim varDays As Variant
    
    ' The number of weekend days.
    Dim varWeekendDays As Variant
    
    ' Temporary storage for datetime.
    Dim dtmX As Date
    
    ' If the end date is earlier, swap the dates.
    If endDate < startDate Then
        dtmX = startDate
        startDate = endDate
        endDate = dtmX
    End If
    
    ' Calculate the number of days inclusive (+ 1 is to add back startDate).
    varDays = DateDiff(Interval:="d", _
        date1:=startDate, _
        date2:=endDate) + 1
    
    ' Calculate the number of weekend days.
    varWeekendDays = (DateDiff(Interval:="ww", _
        date1:=startDate, _
        date2:=endDate) _
        * ncNumberOfWeekendDays) _
        + IIf(DatePart(Interval:="w", _
        Date:=startDate) = vbSunday, 1, 0) _
        + IIf(DatePart(Interval:="w", _
        Date:=endDate) = vbSaturday, 1, 0)
    
    ' Calculate the number of weekdays.
    Weekdays = (varDays - varWeekendDays)
    
Weekdays_Exit:
    Exit Function
    
Weekdays_Error:
    Weekdays = -1
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
        vbCritical, "Weekdays"
    Resume Weekdays_Exit
End Function

Can someone help walk me through how I'd take each employee's schedule into consideration. I'm no vba pro and I'm rusty, been a long time since I messed with this particular app. Any help would be appreciated. Thanks

 

[thechazm]

I'm a little confused at what you actually want your output to be. You said you want to account for personnel and to take their schedule into consideration right?

Consideration to what? What specifically do you mean account for? Do you mean that if they didn't show up to work on time or not at all flag them or are you trying to eventually calculate out your workforce daily?

Just a few more details please and I'm sure someone can help.

 

[rmulder]

Ok, let me see if I can clarify. Right now when I enter a new time off request for an employee, I input a start date and a end date. Then I call the WorkDays function to calculate how many "working days" that date range accounts for. Problem is, those formulas only count monday-friday non holidays as work days. I have employees with schedules other than mon-fri. Many people have schedules of such mon, wed, fri, sat. So for example, if I input a time off request for that kind of employee of mon - wed, it counts for 3 days right now. It should only count for 2 for that employee because he normally has tues off.

It seems very complicated to me how I'm going to calculate the working days taken off based on each employees schedule. Some direction of how I can work it in and I'll start giving it a shot :S

 

[Privateer]

Each day of the week is numbered, Sunday is one, Monday is two, etc. I would create a table with the employee ID and the five numbers that represent the days the guy works. So if a guy works Monday (2), Wednesday (4), and Friday (6) you have three records for him, his ID number and 2, ID, 4 and ID 6. The fields would be EmployeeID and WorksOn

Using the start end dates for his vacation of Monday to Friday, where the dates are changed to the work day numbers, you can match up the 2,4&6 and count the three days he would have worked and by subtracting the three from the five total vacation days, get the two that he would not have worked. Anyway, that is my humble suggestion.
Privateer

 

[thechazm]

I had some time and wrote an example database that sortof does what your talking about. Download it below and break it appart you'll see what I did.

View attachment takeoff.zip


Also here is a preview of the code and it seems to work just fine.

Function CheckSchedule(lngID As Long, sDate As Date, EDate As Date) As Long
Dim db As Database, rs As DAO.Recordset
Dim dChecker As Date, dCounter As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("Select * from [(Code) CheckSchedule] WHERE((([ID]) = " & lngID & "));", dbOpenSnapshot)
If Not rs.EOF Then
    dChecker = sDate
    dCounter = 0
    Do While dChecker < EDate
        If rs(CStr(CDatetoNumber(dChecker))) = True Then
            dCounter = dCounter + 1
        End If
        dChecker = DateAdd("d", 1, dChecker)
    Loop
    CheckSchedule = dCounter
 
End If
rs.Close
Set rs = Nothing
Set db = Nothing
 
End Function
 
Function CDatetoNumber(dDate As Date) As Long
    CDatetoNumber = Weekday(dDate, vbMonday)
End Function

Also thanks for giving more details.