Help on query to add "expected by" date in workdays

obusweetpea

New member
Local time
Today, 13:15
Joined
Jan 8, 2018
Messages
3
Good afternoon, all! I am very new to Access, and even newer to VBA. I recently designed a database for work, and I'm trying to create a new query. For my new query, I have a "DateReturned" field in an existing table, and I want to run all records, adding 10 working days to the "DateReturned" to display the "ExpectedBy" date. Can someone please advise the easiest way to do this? I do already have a module which calculates working days (excluding holidays) between two dates, but I can't seem to get it to work in the new query. The code for that module is below.

TIA for any and all assistance. Also, as a beginner, elementary terminology is appreciated whenever possible. Thanks!


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
 
Hi, Pat. Thank you for your reply! I have tried several times to open the attachment here, but it just will not open for me. I've extracted the database, but when it opens in Access I just get chimes like when you're trying to close down an application with a dialog box still open. I even have to use the Task Manager to force close. Is this protected in some way?

First time on this forum and I can't even open the file! I promise I am NOT an idiot. :)
 
With my special detective powers, I know you only have one monitor!

Pat uploaded a version where the start form tries to open on a secondary monitor.
If you don't have 2 monitors, you get the problem you had

Corrected version attached. Its definitely worth looking at.
 

Attachments

here is another custom-made function just
for you. you can use it in query or an
expression in your form. copy and paste to
standard module:
Code:
'
' arnelgp
'
' parameters:
'
'   DataParam       = the date (starting)
'   NumberToAdd     = number of days to add
'   HolidayTable    = the name of Holiday table (optional)
'   HolidayField    = the fieldname (date field) on holiday table
'   WeekEnds        = array holding the names of WeekEnds (eg: Array("Sat","Sun"))
'
' example:
'
'   if no holiday table and no weekend specifield (Sat and Sun automatic)
'
'   Me.NextDeliveryDate = fncAddWorkDays(DataParam:=[LastDeliveryDate], NumToAdd:=20)
'
'
'   with holiday table and weekend explicitly specified
'
'   Me.NextDeliveryDate = fncAddWorkDays(DataParam:=[LastDeliveryDate], NumToAdd:=20, WeekEnds:=Array("Sat","Sun"))
'
Public Function fncAddWorkDays(ByVal DateParam As Date, _
                                ByVal NumberToAdd As Integer, _
                                Optional ByVal HolidayTable As String, _
                                Optional ByVal HolidayField As String, _
                                Optional WeekEnds As Variant) As Date
Dim dteLoop As Date
Dim arrExcluded() As String
Dim strWeekEnds As String
Dim intExcluded As Integer
Dim rs As DAO.Recordset
If IsMissing(WeekEnds) Then
    WeekEnds = Array("Sat", "Sun")
End If
strWeekEnds = Join(WeekEnds, "/")
' loop until we get to (DataParam + NumberToAdd)
For dteLoop = DateParam + 1 To DateParam + NumberToAdd
    If InStr(strWeekEnds, Format(dteLoop, "ddd")) > 0 Then
        If IsArrInit(arrExcluded) Then
            ReDim Preserve arrExcluded(UBound(arrExcluded) + 1)
        Else
            ReDim arrExcluded(0)
        End If
        ' add excluded date to array
        arrExcluded(UBound(arrExcluded)) = Format(dteLoop, "mm/dd/yyyy")
    End If
Next
'open holiday table, if exists
If HolidayTable <> "" Then
    Set rs = CurrentDb.OpenRecordset( _
        "SELECT [" & HolidayField & "] FROM [" & HolidayTable & "] " & _
        "WHERE [" & HolidayField & "] BETWEEN #" & _
        Format(DateParam + 1, "mm/dd/yyyy") & "# AND #" & _
        Format(DateParam + NumberToAdd, "mm/dd/yyyy") & "#")
    With rs
        If Not (.BOF And .EOF) Then .MoveFirst
        While Not .EOF
            If Not InArray(arrExcluded, Format(rs(0), "mm/dd/yyyy")) Then
                intExcluded = intExcluded + 1
            End If
            .MoveNext
        Wend
        .Close
    End With
    Set rs = Nothing
End If
fncAddWorkDays = DateParam + NumberToAdd + intExcluded + IIf(IsArrInit(arrExcluded), UBound(arrExcluded) + 1, 0)
Erase arrExcluded
End Function

Private Function IsArrInit(arry As Variant)
    Dim i As Integer
    On Error GoTo err_handler
    i = UBound(arry)
    IsArrInit = True
    Exit Function
err_handler:
    IsArrInit = False
End Function

Private Function InArray(arr As Variant, elem As Variant) As Boolean
Dim var As Variant
If IsArrInit(arr) Then
    For Each var In arr
        If var = elem Then
            InArray = True
            Exit For
        End If
    Next
End If
End Function
 
That's very odd.
I just downloaded it from the site & it opens fine for me here using Access 2010

Even opens for me.
However 9th January as base date and 1st date of quarter gives 1st July, and Last Day of month gives me 30 September?
 
Hi Pat

I've just checked & the date app is indeed giving incorrect answers.
I got the same as Gasman for the first date in the quarter
For first day of the month , I'm getting 1 Sept 2018 ...

attachment.php


First day of week => 26 Aug 2018 etc

Its obvious to me why this is happening but I'll leave it to you to fix rather than alter your app myself
 

Attachments

  • Capture.PNG
    Capture.PNG
    17.3 KB · Views: 518
Last edited:
Yes I knew why it was happening .....:D
I've just looked at the other tabs and unless I missed something, the rest are ok

For info, I uploaded a much simpler Easter calculator to the code repository several months ago. Its based on Excel code by Chip Pearson which I adapted for Access.
Have a look here:
https://www.access-programmers.co.uk/forums/showthread.php?t=294630
 
Umm... same issue with your start up form on secondary monitor. :rolleyes:
Corrected version attached

First tab now working perfectly for me in the UK
Did you look at the Easter code I posted?
 

Attachments

So, after posting and testing out some of the codes in the responses, I found out that the 10 days for "Expected by" does not have to exclude weekends and holidays after all. I wish I had known that beforehand. Thank you to everyone for your replies! I am saving them so, if things should change, I will know how to proceed. I really appreciate everyone's help! This seems like a great exchange. Blessings!
 
Hi Pat

I had similar problems to you in the past when I shifted the main Access window to the secondary monitor.
However in my case, the startup popup form always opened on the primary monitor - the opposite to your situation

When testing yours, I had always opened each version from a trusted location.
Anyway, you'll be very pleased to know the issue has been fixed - at least for me.
Tested on a 2 monitor desktop AND a Windows tablet PC running Access.

Thanks for adding the Easter calculator
I haven't checked whether the 2 different versions give identical results for each year though it might be a good idea to do so.
The one I provided based on Chip Pearson's Excel version should apparently be correct until 2368 - which is good enough for me!

Both give the same result for 2369 for anyone wanting to book ahead ....;)
 
Last edited:
I included both because the calculations are interesting. I can't say that I understand them though.

Nonsense they are so easy ....! :eek:
OK ... I admit it. I can't understand them either - but they work

Chip Pearson's formula is so concise that its almost unbelievable that it works
I'm still intrigued why Chip stated his was OK till 2368
 

Users who are viewing this thread

Back
Top Bottom