Calculated Total Days Vacation taken

mike60smart

mike60smart

Registered User.
Local time
Today, 10:54
Joined
Aug 6, 2017
Messages
2,121
Hi

I am trying to create a Calculation that would work out the number of Days Vacation taken with the criteria that
Friday, Saturday, Sundays and Holidays should be excluded.

Is there a way to modify this code supplied by Brent Spaulding?

Code: 
Public Function fNetWorkdays(ByVal dtStartDate As Date, ByVal dtEndDate As Date, _

Optional blIncludeStartdate As Boolean = False) _

As Long

'Returns the number of workdays between the two passed dates. Saturdays and

'Sundays are NOT considered workdays. Plus there is an assumption that a

'table exists that is named tblHolidays that identifies EACH holiday date

'in a field named HolidayDate. By default the function will NOT count the

'first date in the range as a work date, if you pass a True value to

'blIncludeStartdate, the function will count the start date as a work date

'if it is not a Saturday,Sunday or Holiday.

'''''''''''''''''''''''''''''''''''''''''''

'Author: Brent Spaulding

'Version: 8

'Date: Jun 7 2011

'''''''''''''''''''''''''''''''''''''''''''

'Ver Description

'?-3 Intial releases to UA in various threads and the Code Archive

'4 Made the function cabable of handling Start dates that are Greater

' than End dates

'5 Fixed bug when the start date was a holiday and the SQL when end < start

'6 Modified the structure a bit, logically equivalent, but I only test

' for dtStartDate <= dtEndDate once, instead of 3 times.

'7 Formated date literals to corrected for possible errors with

' NON-US Regional Settings (Thanks to UA user fazered for notification of issue!).

'8 Fixed but when start date is Weekend or Holiday and blIncludeStartdate was false.

'..........................................



Dim lngDays As Long

Dim lngSaturdays As Long

Dim lngSundays As Long

Dim lngHolidays As Long

Dim lngAdjustment As Long

Dim blStartIsHoliday As Boolean

Dim strSQL As String



'Count the number of RAW days between the dates ...

lngDays = Abs(DateDiff("d", dtStartDate, dtEndDate))



'Count the number of Saturdays & Sundays between the two dates. Note the use of "w" as

'the date interval which will count the <day of first date in DateDiff()>.

'So, to count the Saturdays, I adjust the start date of the datediff function

'to the saturday BEFORE the dtStartDate of the passed range, thus the number

'of Saturdays between the passed range is returned. Investigated "ww"

'for Sundays, but when the end is less than the start, problems arose.

'This block also builds the SQL for extracting holidays.

If dtStartDate <= dtEndDate Then



lngSaturdays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, _

dtStartDate, _

dtStartDate - Weekday(dtStartDate, vbSunday)), _

dtEndDate))



lngSundays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSunday, _

dtStartDate, _

dtStartDate - Weekday(dtStartDate, vbSunday) + 1), _

dtEndDate))



strSQL = "SELECT HolidayDate FROM tblHolidays" & _

" WHERE HolidayDate" & _

" Between #" & Format(dtStartDate, "yyyy-mm-dd") & "#" & _

" And #" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _

" And Weekday(HolidayDate, 1) Not In (1,7)" & _

" ORDER BY HolidayDate DESC"



Else



lngSaturdays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, _

dtStartDate, _

dtStartDate + (7 - Weekday(dtStartDate, vbSunday))), _

dtEndDate))



lngSundays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSunday, _

dtStartDate, _

dtStartDate + (7 - Weekday(dtStartDate, vbSunday)) + 1), _

dtEndDate))



strSQL = "SELECT HolidayDate FROM tblHolidays" & _

" WHERE HolidayDate" & _

" Between #" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _

" And #" & Format(dtStartDate, "yyyy-mm-dd") & "#" & _

" And Weekday(HolidayDate, 1) Not In (1,7)" & _

" ORDER BY HolidayDate DESC"



End If



'Count the number of holidays AND determine if the start date is a holiday

'the SQL is built in the IF..Then above.

With CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

If Not .EOF Then



'Get the number of holidays between the dates specified.

'Need to populate a DAO recordset to ensure a good rcd count

.MoveLast



'Determine if the start date is a holiday. Since the rst is

'in descending order the last record SHOULD be no earlier than

'the start date, so if the start date is equal to the LAST record

'then, the start date is a holiday.... Unless we are in a "Negative"

'situation, then the FIRST record must be checked.

If dtStartDate > dtEndDate Then

.MoveFirst

End If



'Determine if the start is a holiday ... if it is, then DON'T include

'it in the count of holidays since the first day is NOT included by

'default in the total network days...

blStartIsHoliday = (!HolidayDate = dtStartDate)

If blStartIsHoliday Then

lngHolidays = .RecordCount - 1

Else

lngHolidays = .RecordCount

End If



End If



.Close



End With



'Make an adjustment based different situations ... basically if the start is

'a weekend or holiday, the no need to include the start date, otherwise if

'the start date is a workdate and the user specified to include it, then

'adjust for that situation.

'...Order of the Case statements is critical

Select Case True



Case Weekday(dtStartDate, vbSaturday) <= 2, blStartIsHoliday

If dtStartDate = dtEndDate Then

lngAdjustment = 0

Else

lngAdjustment = Not blIncludeStartdate

End If



Case blIncludeStartdate

lngAdjustment = 1



End Select



'Return the result

fNetWorkdays = (lngDays - lngSundays - lngSaturdays - lngHolidays + lngAdjustment)

If dtStartDate > dtEndDate Then

fNetWorkdays = 0 - fNetWorkdays

End If



End Function





Public Function fAddWorkdays(dtStartDate As Date, _

lngWorkDays As Long) _

As Date

'Adds the passed number of workdays to a passed date. This code uses

'fNetWorkdays(), so the assumptions of tblHoliday apply for this function

'as well. Also note that if a ZERO is entered as the lngWorkDays parameter

'the function will return the start date, if its a work day, or the first

'workday PRIOR to the dtStartdate.

'''''''''''''''''''''''''''''''''''''''''''

'Author: Brent Spaulding

'Version: 7

'Date: Aug 8 2008

'''''''''''''''''''''''''''''''''''''''''''

'Revision History:

'Ver Description

'?-4 Intial releases to UA in various threads and the Code Archive

'5 Made the function cabable of handling negative work days to add

'6 Corrected for a DIV by Zero error when 0 was entered as lngWorkdays

' as well as some buggy stuff with negative workdays

'7 Formated date literals to corrected for possible errors with

' NON-US Regional Settings (Thanks to UA user fazered for notification of issue!).

'..........................................



Dim dtEndDate As Date

Dim lngDays As Long

Dim lngSaturdays As Long

Dim lngOffset As Long

Dim lngSundays As Long



'First ... GUESS at the End Date you need to cover the workdays you are adding.

'I ASSUME that the number of days that are added will always toss you into a

'week end, then I add the number of work weeks to it the get the number of

'saturdays and sundays.

lngSaturdays = 1 + Abs(lngWorkDays) \ 5

lngSundays = lngSaturdays



dtEndDate = DateAdd("d", Sgn(lngWorkDays) * (Abs(lngWorkDays) + lngSaturdays + lngSundays), dtStartDate)



'Next, as much as I hate to do it, loop until the fNetWorkdays equals the number

'of days requested.

Do Until lngWorkDays = lngDays



'Count the number of work days between the ESTIMATED end date

'and the start date

lngDays = fNetWorkdays(dtStartDate, dtEndDate, False)



'Make an adjustment to the end date

If lngDays <> lngWorkDays Then

lngOffset = lngWorkDays - lngDays

dtEndDate = dtEndDate + lngOffset

End If



Loop



'Determine the offset direction to adjust for weekends and holidays

'the offset trys to bring the end date CLOSER to the start date.

If lngWorkDays < 0 Then lngOffset = 1 Else lngOffset = -1



'Make sure the end day is NOT a holiday and NOT a Saturday/Sunday

Do Until DCount("*", "tblHolidays", "[HolidayDate]=#" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _

" And Weekday([HolidayDate],1) Not In (1,7)") = 0 _

And Weekday(dtEndDate, vbMonday) < 6 '6th day of week if Mon is first day

dtEndDate = dtEndDate + lngOffset

Loop



'Once we are out of the loop, the end date should be set to the correct date

fAddWorkdays = dtEndDate



End Function
 
He is only allowing for weekdays 1 and 7, so you need to add your weekday number you want to exclude, plus any date that is not one of those, but is a holiday?
 
Hi Gasman
I tried modifying the Code as shown below:-
But it still does not exclude the Friday?

Code: 
Public Function fNetWorkdays(ByVal dtStartDate As Date, ByVal dtEndDate As Date, _
                             Optional blIncludeStartdate As Boolean = False) _
                             As Long
'Returns the number of workdays between the two passed dates.  Saturdays and
'Sundays are NOT considered workdays.  Plus there is an assumption that a
'table exists that is named tblHolidays that identifies EACH holiday date
'in a field named HolidayDate.  By default the function will NOT count the
'first date in the range as a work date, if you pass a True value to
'blIncludeStartdate, the function will count the start date as a work date
'if it is not a Saturday,Sunday or Holiday.
'''''''''''''''''''''''''''''''''''''''''''
'Author: Brent Spaulding
'Version: 8
'Date: Jun 7 2011
'''''''''''''''''''''''''''''''''''''''''''
'Ver    Description
'?-3    Intial releases to UA in various threads and the Code Archive
'4      Made the function cabable of handling Start dates that are Greater
'       than End dates
'5      Fixed bug when the start date was a holiday and the SQL when end < start
'6      Modified the structure a bit, logically equivalent, but I only test
'       for dtStartDate <= dtEndDate once, instead of 3 times.
'7      Formated date literals to corrected for possible errors with
'       NON-US Regional Settings (Thanks to UA user fazered for notification of issue!).
'8      Fixed but when start date is Weekend or Holiday and blIncludeStartdate was false.
'..........................................
    
    Dim lngDays As Long
    Dim lngSaturdays As Long
    Dim lngSundays As Long
    Dim lngHolidays As Long
    Dim lngAdjustment As Long
    Dim blStartIsHoliday As Boolean
    Dim strSQL As String
    
    'Count the number of RAW days between the dates ...
    lngDays = Abs(DateDiff("d", dtStartDate, dtEndDate))
    
    'Count the number of Saturdays & Sundays between the two dates.  Note the use of "w" as
    'the date interval which will count the <day of first date in DateDiff()>.
    'So, to count the Saturdays, I adjust the start date of the datediff function
    'to the saturday BEFORE the dtStartDate of the passed range, thus the number
    'of Saturdays between the passed range is returned.  Investigated "ww"
    'for Sundays, but when the end is less than the start, problems arose.
    'This block also builds the SQL for extracting holidays.
    If dtStartDate <= dtEndDate Then
    
        lngSaturdays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday)), _
                                dtEndDate))
    
        lngSundays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSunday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday) + 1), _
                                dtEndDate))
    
        strSQL = "SELECT HolidayDate FROM tblHolidays" & _
                 " WHERE HolidayDate" & _
                        " Between #" & Format(dtStartDate, "yyyy-mm-dd") & "#" & _
                            " And #" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _
                        " And Weekday(HolidayDate, 1) Not In (1,5,7)" & _
                 " ORDER BY HolidayDate DESC"
    
    Else
    
        lngSaturdays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, _
                            dtStartDate, _
                            dtStartDate + (7 - Weekday(dtStartDate, vbSunday))), _
                            dtEndDate))
    
        lngSundays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSunday, _
                            dtStartDate, _
                            dtStartDate + (7 - Weekday(dtStartDate, vbSunday)) + 1), _
                            dtEndDate))
    
        strSQL = "SELECT HolidayDate FROM tblHolidays" & _
                 " WHERE HolidayDate" & _
                        " Between #" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _
                            " And #" & Format(dtStartDate, "yyyy-mm-dd") & "#" & _
                        " And Weekday(HolidayDate, 1) Not In (1,5,7)" & _
                 " ORDER BY HolidayDate DESC"
    
    End If
    
    'Count the number of holidays AND determine if the start date is a holiday
    'the SQL is built in the IF..Then above.
    With CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
        If Not .EOF Then
    
            'Get the number of holidays between the dates specified.
            'Need to populate a DAO recordset to ensure a good rcd count
            .MoveLast
    
            'Determine if the start date is a holiday.  Since the rst is
            'in descending order the last record SHOULD be no earlier than
            'the start date, so if the start date is equal to the LAST record
            'then, the start date is a holiday.... Unless we are in a "Negative"
            'situation, then the FIRST record must be checked.
            If dtStartDate > dtEndDate Then
                .MoveFirst
            End If
    
            'Determine if the start is a holiday ... if it is, then DON'T include
            'it in the count of holidays since the first day is NOT included by
            'default in the total network days...
            blStartIsHoliday = (!HolidayDate = dtStartDate)
            If blStartIsHoliday Then
                lngHolidays = .RecordCount - 1
            Else
                lngHolidays = .RecordCount
            End If
    
        End If


        .Close


    End With
    
    'Make an adjustment based different situations ... basically if the start is
    'a weekend or holiday, the no need to include the start date, otherwise if
    'the start date is a workdate and the user specified to include it, then
    'adjust for that situation.
    '...Order of the Case statements is critical
    Select Case True
            
        Case Weekday(dtStartDate, vbSaturday) <= 2, blStartIsHoliday
            If dtStartDate = dtEndDate Then
                lngAdjustment = 0
            Else
                lngAdjustment = Not blIncludeStartdate
            End If
                        
        Case blIncludeStartdate
            lngAdjustment = 1
    
    End Select


    'Return the result
    fNetWorkdays = (lngDays - lngSundays - lngSaturdays - lngHolidays + lngAdjustment)
    If dtStartDate > dtEndDate Then
        fNetWorkdays = 0 - fNetWorkdays
    End If
    
End Function
    
    
Public Function fAddWorkdays(dtStartDate As Date, _
                             lngWorkDays As Long) _
                             As Date
'Adds the passed number of workdays to a passed date.  This code uses
'fNetWorkdays(), so the assumptions of tblHoliday apply for this function
'as well. Also note that if a ZERO is entered as the lngWorkDays parameter
'the function will return the start date, if its a work day, or the first
'workday PRIOR to the dtStartdate.
'''''''''''''''''''''''''''''''''''''''''''
'Author: Brent Spaulding
'Version: 7
'Date: Aug 8 2008
'''''''''''''''''''''''''''''''''''''''''''
'Revision History:
'Ver    Description
'?-4    Intial releases to UA in various threads and the Code Archive
'5      Made the function cabable of handling negative work days to add
'6      Corrected for a DIV by Zero error when 0 was entered as lngWorkdays
'       as well as some buggy stuff with negative workdays
'7      Formated date literals to corrected for possible errors with
'       NON-US Regional Settings (Thanks to UA user fazered for notification of issue!).
'..........................................
    
    Dim dtEndDate As Date
    Dim lngDays As Long
    Dim lngSaturdays As Long
    Dim lngOffset As Long
    Dim lngSundays As Long
    
    'First ... GUESS at the End Date you need to cover the workdays you are adding.
    'I ASSUME that the number of days that are added will always toss you into a
    'week end, then I add the number of work weeks to it the get the number of
    'saturdays and sundays.
    lngSaturdays = 1 + Abs(lngWorkDays) \ 5
    lngSundays = lngSaturdays
    
    dtEndDate = DateAdd("d", Sgn(lngWorkDays) * (Abs(lngWorkDays) + lngSaturdays + lngSundays), dtStartDate)
    
    'Next, as much as I hate to do it, loop until the fNetWorkdays equals the number
    'of days requested.
    Do Until lngWorkDays = lngDays
    
        'Count the number of work days between the ESTIMATED end date
        'and the start date
        lngDays = fNetWorkdays(dtStartDate, dtEndDate, False)
    
        'Make an adjustment to the end date
        If lngDays <> lngWorkDays Then
            lngOffset = lngWorkDays - lngDays
            dtEndDate = dtEndDate + lngOffset
        End If
    
    Loop
    
    'Determine the offset direction to adjust for weekends and holidays
    'the offset trys to bring the end date CLOSER to the start date.
    If lngWorkDays < 0 Then lngOffset = 1 Else lngOffset = -1
    
    'Make sure the end day is NOT a holiday and NOT a Saturday/Sunday
    Do Until DCount("*", "tblHolidays", "[HolidayDate]=#" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _
                                " And Weekday([HolidayDate],1) Not In (1,5,7)") = 0 _
             And Weekday(dtEndDate, vbMonday) < 5 '6th day of week if Mon is first day
        dtEndDate = dtEndDate + lngOffset
    Loop
    
    'Once we are out of the loop, the end date should be set to the correct date
    fAddWorkdays = dtEndDate
    
End Function
 
Hi Mike,

In Brent's function, to return the number of workdays, he has this piece of the code:
Code: 
'Return the result

fNetWorkdays = (lngDays - lngSundays - lngSaturdays - lngHolidays + lngAdjustment)
I imagine all you need to do is add another calculation for lngFridays and include it in that line.
 
Plus Friday is 6 if you do not specify a parameter?🙄
Where do you think the 1 and 7 came from?

Code: 
? weekday(date-2)
6
 
Hi Gasman
I believe the modification I made is now calculating the Days Taken as expected.
I am now off to watch the England v Italy Game.
 
theDBguy said:
Hi Mike,

In Brent's function, to return the number of workdays, he has this piece of the code:
Code: 
'Return the result

fNetWorkdays = (lngDays - lngSundays - lngSaturdays - lngHolidays + lngAdjustment)
I imagine all you need to do is add another calculation for lngFridays and include it in that line.
Click to expand...
Hi Guy

So the code for Saturdays & Sundays is as follows:-

Code: 
lngSaturdays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday)), _
                                dtEndDate))
    
        lngSundays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSunday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday) + 1), _
                                dtEndDate))

How would I add the lngFriday lines? Would the following be correct?

Code: 
lngFridays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbFriday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday)), _
                                dtEndDate))
 
mike60smart said:
Hi Guy

So the code for Saturdays & Sundays is as follows:-

Code: 
lngSaturdays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday)), _
                                dtEndDate))
   
        lngSundays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSunday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday) + 1), _
                                dtEndDate))

How would I add the lngFriday lines? Would the following be correct?

Code: 
lngFridays = Abs(DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbFriday, _
                                dtStartDate, _
                                dtStartDate - Weekday(dtStartDate, vbSunday)), _
                                dtEndDate))
Click to expand...
Looks fine to me. Have you tried it? What happened?
 
You must log in or register to reply here.

Similar threads

Gasman
nth Day of month
Replies
4
Views
964
ebs17
E
A
Solved Code cannot differentiate between regional dates
Replies
5
Views
674
Ajabu
A
MikeT1941
Solved Difficulties in creating "copy" type records
Replies
18
Views
1,135
Pat Hartman
P
V
Trying to have a button on a form open a report with info from a list box
Replies
18
Views
1,222
moke123
moke123
T
Solved Current week Date formatting [Query]
Replies
17
Views
2,392
theDBguy
theDBguy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom