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
> Need Some Help Please-how To *include Weekends And Holidays With Previous Work Day, Access 2016    
 
   
fst100
post May 28 2020, 07:37 AM
Post#1



Posts: 4
Joined: 24-October 18



did a few searches and majority of the searches were ones excluding weekends and holidays pullhair.gif . so im trying to put together a query where I need to pull prior business day (mon-fri). where im trying to figure out is if I can do this in a query/SQL or in a module? basically I need to return prior day but if today is Monday for example, then prior business day would be Friday but I need to include the weekend data in with Friday. what's even more of a moneky wnrech in the gears are holidays. some like this past memorial day is on a Monday so if today was tueday then I need to get data from fri-mon. so I imagine I would need a table strictly for holidays correct (or maybe have a table with just weekends and holidays) and use an inner join with the table im pulling from? hopefully this make sense at all? whew.gif
Go to the top of the page
 
GroverParkGeorge
post May 28 2020, 09:23 AM
Post#2


UA Admin
Posts: 37,480
Joined: 20-June 02
From: Newcastle, WA


Search our Code Archives. We have a few code samples that do this.

--------------------
My Real Name Is George. Grover Park Consulting is where I did business for 20 years.
How to Ask a Good Question
Beginning SQL Server
Go to the top of the page
 
wheeledgoat
post May 28 2020, 09:26 AM
Post#3



Posts: 109
Joined: 18-December 18



would it make sense to use weekday instead of workday?

if you're determined to get into the weeds with the workday and holiday functions, drop this into a module and have at it! good luck.

CODE
Option Compare Database

' ********* Code Start **************
'
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
'

Public Function dhAddWorkDaysA(lngDays As Long, _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant) As Date
    ' Add the specified number of work days to the
    ' specified date.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' In:
    '   lngDays:
    '       Number of work days to add to the start date.
    '   dtmDate:
    '       date on which to start looking.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value, if that's what you want.
    ' Out:
    '   Return Value:
    '       The date of the working day lngDays from the start, taking
    '       into account weekends and holidays.
    ' Example:
    '   dhAddWorkDaysA(10, #2/9/2000#, Array(#2/16/2000#, #2/17/2000#))
    '   returns #2/25/2000#, which is the date 10 work days
    '   after 2/9/2000, if you treat 2/16 and 2/17 as holidays
    '   (just made-up holidays, for example purposes only).
    
    ' Did the caller pass in a date? If not, use
    ' the current date.
    Dim lngCount As Long
    Dim dtmTemp As Date
    
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    
    dtmTemp = dtmDate
    For lngCount = 1 To lngDays
        dtmTemp = dhNextWorkdayA(dtmTemp, adtmDates)
    Next lngCount
    dhAddWorkDaysA = dtmTemp
End Function

Public Function dhNextWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
    
    ' Return the next working day after the specified date.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Requires:
    '   SkipHolidays
    '   IsWeekend
    
    ' In:
    '   dtmDate:
    '       date on which to start looking.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value.
    ' Out:
    '   Return Value:
    '       The date of the next working day, taking
    '       into account weekends and holidays.
    ' Example:
    '   ' Find the next working date after 5/30/97
    '   dtmDate = dhNextWorkdayA(#5/23/1997#, #5/26/97#)
    '   ' dtmDate should be 5/27/97, because 5/26/97 is Memorial day.
    
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    
    dhNextWorkdayA = SkipHolidaysA(adtmDates, dtmDate + 1, 1)
End Function

Public Function dhPreviousWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
    
    ' Return the previous working day before the specified date.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Requires:
    '   SkipHolidays
    '   IsWeekend
    
    ' In:
    '   dtmDate:
    '       date on which to start looking.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value.
    ' Out:
    '   Return Value:
    '       The date of the previous working day, taking
    '       into account weekends and holidays.
    ' Example:
    '   ' Find the next working date before 1/1/2000
    
    '   dtmDate = dhPreviousWorkdayA(#1/1/2000#, Array(#12/31/1999#, #1/1/2000#))
    '   ' dtmDate should be 12/30/1999, because of the New Year's holidays.
    
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    
    dhPreviousWorkdayA = SkipHolidaysA(adtmDates, dtmDate - 1, -1)
End Function

Public Function dhFirstWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
    
    ' Return the first working day in the month specified.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Requires:
    '   SkipHolidays
    '   IsWeekend
    
    ' In:
    '   dtmDate:
    '       date within the month of interest.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value.
    ' Out:
    '   Return Value:
    '       The date of the first working day in the month, taking
    '       into account weekends and holidays.
    ' Example:
    '   ' Find the first working day in 1999
    '   dtmDate = dhFirstWorkdayInMonthA(#1/1/1999#, #1/1/1999#)
    
    Dim dtmTemp As Date
    
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    
    dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate), 1)
    dhFirstWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, 1)
End Function

Public Function dhLastWorkdayInMonthA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date
    
    ' Return the last working day in the month specified.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Requires:
    '   SkipHolidays
    '   IsWeekend
    
    ' In:
    '   dtmDate:
    '       date within the month of interest.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value.
    ' Out:
    '   Return Value:
    '       The date of the last working day in the month, taking
    '       into account weekends and holidays.
    ' Example:
    '   ' Find the last working day in 1999
    '   dtmDate = dhLastWorkdayInMonthA(#12/1/1999#, #12/31/1999#)
    
    Dim dtmTemp As Date
    
    ' Did the caller pass in a date? If not, use
    ' the current date.
    If dtmDate = 0 Then
        dtmDate = Date
    End If
    
    dtmTemp = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
    dhLastWorkdayInMonthA = SkipHolidaysA(adtmDates, dtmTemp, -1)
End Function

Public Function dhCountWorkdaysA(ByVal dtmStart As Date, ByVal dtmEnd As Date, _
Optional adtmDates As Variant = Empty) _
As Integer

    ' Count the business days (not counting weekends/holidays) in
    ' a given date range.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Requires:
    '   SkipHolidays
    '   CountHolidays
    '   IsWeekend
    
    ' In:
    '   dtmStart:
    '       Date specifying the start of the range (inclusive)
    '   dtmEnd:
    '       Date specifying the end of the range (inclusive)
    '       (dates will be swapped if out of order)
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value.
    ' Out:
    '   Return Value:
    '       Number of working days (not counting weekends and optionally, holidays)
    '       in the specified range.
    ' Example:
    '   Debug.Print dhCountWorkdaysA(#7/2/2000#, #7/5/2000#, _
    '    Array(#1/1/2000#, #7/4/2000#))
    '
    '   returns 2, because 7/2/2000 is Sunday, 7/4/2000 is a holiday,
    '   leaving 7/3 and 7/5 as workdays.
    
    Dim intDays As Integer
    Dim dtmTemp As Date
    Dim intSubtract As Integer
    
    ' Swap the dates if necessary.>
    If dtmEnd < dtmStart Then
        dtmTemp = dtmStart
        dtmStart = dtmEnd
        dtmEnd = dtmTemp
    End If
    
    ' Get the start and end dates to be weekdays.
    dtmStart = SkipHolidaysA(adtmDates, dtmStart, 1)
    dtmEnd = SkipHolidaysA(adtmDates, dtmEnd, -1)
    If dtmStart > dtmEnd Then
        ' Sorry, no Workdays to be had. Just return 0.
        dhCountWorkdaysA = 0
    Else
        intDays = dtmEnd - dtmStart + 1
        
        ' Subtract off weekend days.  Do this by figuring out how
        ' many calendar weeks there are between the dates, and
        ' multiplying the difference by two (because there are two
        ' weekend days for each week). That is, if the difference
        ' is 0, the two days are in the same week. If the
        ' difference is 1, then we have two weekend days.
        intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)
        
        ' The answer to our quest is all the weekdays, minus any
        ' holidays found in the table.
        intSubtract = intSubtract + _
         CountHolidaysA(adtmDates, dtmStart, dtmEnd)
        
        dhCountWorkdaysA = intDays - intSubtract
    End If
End Function

Private Function CountHolidaysA( _
adtmDates As Variant, _
dtmStart As Date, dtmEnd As Date) As Long

    ' Count holidays between two end dates.
    '
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Required by:
    '   dhCountWorkdays
    
    ' Requires:
    '   IsWeekend
    
    
    Dim lngItem As Long
    Dim lngCount As Long
    Dim blnFound As Long
    Dim dtmTemp As Date
    
    On Error GoTo HandleErr
    lngCount = 0
    Select Case VarType(adtmDates)
        Case vbArray + vbDate, vbArray + vbVariant
            ' You got an array of variants, or of dates.
            ' Loop through, looking for non-weekend values
            ' between the two endpoints.
            For lngItem = LBound(adtmDates) To UBound(adtmDates)
                dtmTemp = adtmDates(lngItem)
                If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then
                    If Not IsWeekend(dtmTemp) Then
                        lngCount = lngCount + 1
                    End If
                End If
            Next lngItem
        Case vbDate
            ' You got one date. So see if it's a non-weekend
            ' date between the two endpoints.
            If adtmDates >= dtmStart And adtmDates <= dtmEnd Then
                If Not IsWeekend(adtmDates) Then
                    lngCount = 1
                End If
            End If
    End Select

ExitHere:
    CountHolidaysA = lngCount
    Exit Function
    
HandleErr:
    ' No matter what the error, just
    ' return without complaining.
    ' The worst that could happen is that the code
    ' include a holiday as a real day, even if
    ' it's in the table.
    Resume ExitHere
End Function

Private Function FindItemInArray(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
    Dim lngItem As Long
    
    On Error GoTo HandleErrors
    
    For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
        If avarItemsToSearch(lngItem) = varItemToFind Then
            FindItemInArray = True
            GoTo ExitHere
        End If
    Next lngItem
    
ExitHere:
    Exit Function
    
HandleErrors:
    ' Do nothing at all.
    ' Return False.
    Resume ExitHere
End Function

Private Function IsWeekend(dtmTemp As Variant) As Boolean
    ' If your weekends aren't Saturday (day 7) and Sunday (day 1),
    ' change this routine to return True for whatever days
    ' you DO treat as weekend days.
    
    ' Modified from code in "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Required by:
    '   SkipHolidays
    '   dhFirstWorkdayInMonth
    '   dbLastWorkdayInMonth
    '   dhNextWorkday
    '   dhPreviousWorkday
    '   dhCountWorkdays
    
    If VarType(dtmTemp) = vbDate Then
        Select Case Weekday(dtmTemp)
            Case vbSaturday, vbSunday
                IsWeekend = True
            Case Else
                IsWeekend = False
        End Select
    End If
End Function

Private Function SkipHolidaysA( _
adtmDates As Variant, _
dtmTemp As Date, intIncrement As Integer) As Date
    ' Skip weekend days, and holidays in the array referred to by adtmDates.
    ' Return dtmTemp + as many days as it takes to get to a day that's not
    ' a holiday or weekend.
    
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
    
    ' Required by:
    '   dhFirstWorkdayInMonthA
    '   dbLastWorkdayInMonthA
    '   dhNextWorkdayA
    '   dhPreviousWorkdayA
    '   dhCountWorkdaysA
    
    ' Requires:
    '   IsWeekend
    
    Dim strCriteria As String
    Dim strFieldName As String
    Dim lngItem As Long
    Dim blnFound As Boolean
    
    On Error GoTo HandleErrors
    
    ' Move up to the first Monday/last Friday, if the first/last
    ' of the month was a weekend date. Then skip holidays.
    ' Repeat this entire process until you get to a weekday.
    ' Unless adtmDates an item for every day in the year (!)
    ' this should finally converge on a weekday.
    
    Do
        Do While IsWeekend(dtmTemp)
            dtmTemp = dtmTemp + intIncrement
        Loop
        Select Case VarType(adtmDates)
            Case vbArray + vbDate, vbArray + vbVariant
                Do
                    blnFound = FindItemInArray(dtmTemp, adtmDates)
                    If blnFound Then
                        dtmTemp = dtmTemp + intIncrement
                    End If
                Loop Until Not blnFound
            Case vbDate
                If dtmTemp = adtmDates Then
                    dtmTemp = dtmTemp + intIncrement
                End If
        End Select
    Loop Until Not IsWeekend(dtmTemp)
    
ExitHere:
    SkipHolidaysA = dtmTemp
    Exit Function
    
HandleErrors:
    ' No matter what the error, just
    ' return without complaining.
    ' The worst that could happen is that we
    ' include a holiday as a real day, even if
    ' it's in the array.
    Resume ExitHere
End Function
' ********* Code End **************

--------------------
"If you don't make mistakes, you're not working on hard enough problems." -Frank Wilczek

"Success is getting what you want. Happiness is wanting what you get." -B.R. Hayden

Virtue is sufficient for happiness, therefore a sage is immune to misfortune.
Go to the top of the page
 
FrankRuperto
post May 28 2020, 10:10 AM
Post#4



Posts: 1,099
Joined: 21-September 14
From: Tampa, Florida USA


Also see this thread: https://www.UtterAccess.com/forum/index.php...2058074&hl=

--------------------
Currently supporting pawnbrokers that use my store management system developed with Access 2010 on Windows7. Experienced with Informix, Oracle & PostgreSQL db's.
Go to the top of the page
 
fst100
post Jun 3 2020, 07:29 AM
Post#5



Posts: 4
Joined: 24-October 18



sorry for the late reply. i'll check out the link as well as the coding you posted wheeledgoat
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    8th July 2020 - 03:34 AM