UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Future Date Calculation, Access 2010    
 
   
HopefullMonkey
post Apr 16 2017, 02:43 PM
Post#1



Posts: 3
Joined: 13-April 17



Hello,

I have found the below in code in the UtterAccess Archive section and I have it working.

I was wondering if you could help. I am trying to get the code to include the first date in calculating the future date.

If I have a start date of 08/05/2017 and a want a date 6 days in the future the code calculates the 16/05/2017 but I am wanting the code to calculate it to 15/05/2017.

I have tried changing the False entry below to True as stated in the code notes but this does not fix my issue.

CODE

Public Function fNetWorkdays(ByVal dtStartDate As Date, ByVal dtEndDate As Date, _
                             Optional blIncludeStartdate As Boolean = False) _


Any help would be greatly apprietated.

Thank you.

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 Holidays that identifies EACH holiday date
'in a field named Holiday.  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 Holiday FROM Holidays" & _
                 " WHERE Holiday" & _
                        " Between #" & Format(dtStartDate, "yyyy-mm-dd") & "#" & _
                            " And #" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _
                        " And Weekday(Holiday, 1) Not In (1,7)" & _
                 " ORDER BY Holiday 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 Holiday FROM Holidays" & _
                 " WHERE Holiday" & _
                        " Between #" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _
                            " And #" & Format(dtStartDate, "yyyy-mm-dd") & "#" & _
                        " And Weekday(Holiday, 1) Not In (1,7)" & _
                 " ORDER BY Holiday 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 = (!Holiday = 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("*", "Holidays", "[Holiday]=#" & Format(dtEndDate, "yyyy-mm-dd") & "#" & _
                                " And Weekday([Holiday],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
Go to the top of the page
 
theDBguy
post Apr 16 2017, 02:59 PM
Post#2


Access Wiki and Forums Moderator
Posts: 70,876
Joined: 19-June 07
From: SunnySandyEggo


Hi,

Unfortunately, if you're trying to calculate a future date, I don't think the function you posted has a provision for counting the start date. So, you might just have to compensate for it when you call the function. For example, rather than adding x days, try adding x-1 days.

Hope it helps...

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Microsoft Access MVP | Access Website | Access Blog | Email
Go to the top of the page
 
SerranoG
post Apr 28 2017, 10:17 AM
Post#3


UtterAccess VIP
Posts: 2,210
Joined: 1-December 03
From: Lansing, MI USA


Not tested.

CODE
Public Function dtmEndDate(dtmStartDate As Date, intDays As Integer) As Date

    'Finds the first workday after intDays days, e.g. six days.
    Dim dtmEnd As Date
    
    dtmEnd = DateAdd("d", intDays, dtmStartDate)
    
    'Check for Sunday.
    If Weekday(dtmEnd) = vbSunday Then
        dtmEnd = DateAdd("d", 1, dtmEnd)
    End If
    
    'Check for Saturday
    If Weekday(dtmEnd) = vbSaturday Then
        dtmEnd = DateAdd("d", 2, dtmEnd)
    End If
    
    'Check for holiday stored in tblHoliday with dtmHoliday (date) and strHoliday (string description)
    If (Nz(DCount("[strHoliday]", "tblHolidays", "[dtmHoliday] = #" & dtmEnd & "#"), 0)) > 0 Then
        'Holiday Found: move up one day, then check with a recursive call to function
        'in case the day after the holiday is also a Sunday or Saturday or another holiday.
        dtmEnd = dtmEndDate(dtmEnd, 1)
    End If
    
    dtmEndDate = dtmEnd

End Function




--------------------
Greg Serrano
Michigan Dept. of Environmental Quality
Air Quality Division
Go to the top of the page
 
Jeff B.
post Apr 28 2017, 10:20 AM
Post#4


UtterAccess VIP
Posts: 9,836
Joined: 30-April 10
From: Pacific NorthWet


?Are you saying you want [yourdate] + 7 as a "future date"?

If so, have you looked into using the DateAdd() function in Access?

--------------------
Regards

Jeff Boyce
Microsoft Access MVP (2002-2015)

Mention of hardware or software is, in no way, an endorsement thereof. The FTC of the USA made this disclaimer necessary/possible.
Go to the top of the page
 
theDBguy
post Apr 28 2017, 10:38 AM
Post#5


Access Wiki and Forums Moderator
Posts: 70,876
Joined: 19-June 07
From: SunnySandyEggo


Hi Greg,

You might be interested to read this article.

Cheers!

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Microsoft Access MVP | Access Website | Access Blog | Email
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    23rd October 2017 - 05:25 PM