Page 1 of 2 12 LastLast
Results 1 to 15 of 16
  1. #1
    jlgray0127 is offline Competent Performer
    Windows 7 64bit Access 2013
    Join Date
    Oct 2011
    Location
    Central Illinois
    Posts
    144

    Calculating a start date using and end date and variables

    I'm moving a production facilities schedule from excel to Access. I'm having trouble calculating out dates. I basically have a schedule that has a ship date. From that, based on the product type, we have a productime time line for all the steps to process these builds, which gets me to the start on line date.



    To try to be as less confusing as possible, below is a snap shot of the table. Product line is the identifier to processes and time (days) to accomplish a build.
    My calculation needs to be my ship date minus the number of days below for each step to get me to the SOL Date, which is when we need to start building.

    However, I have to add a variable... days we are not working on the line.
    I have a table named calendar, which is basically every day of the year (10 years out) with a yes/no box. So, I need to be able to take the [Ship date] - Each step below to get my date. My problem, is I also need to look at my calendar table and only count the work days.

    Something like [Schedule].[Ship date] - Count(Where value is true[Calendar].[CheckBox])=Each column belows Date

    I'm sorry, I tried to make that simple, and it sounds confusing to me, which is what I've done in my head... I think I have made this more complicated by over thinking it all... any help is greatly appreciated.

    For Product Line 1, I need to count only the workdays going backword for each column, and subtract that back from my ship Date.
    Build Time, is total workdays needed to build.
    Product Line (Category) Build Time SOL Sub-Weld Oven Main Weld Ship to Paint/Machining Back From Paint Assembly/Test/PDI/Pack
    1 15 1 2 2 0 7 1 2
    1M 20 1 2 0 1 13 1 2
    2 14 4 4 0 4 0 0 2
    3 15 4 4 1 4 0 0 2
    4 6 1 0 1 3 0 0 1

  2. #2
    ranman256's Avatar
    ranman256 is online now VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    8,333
    make 1 query, qsWorkDays,
    :select date from tCalendar where [IsWorkDate]=true

    make another query, qsWorkDaysCount,
    this will read a date range off a form and only bring in the dates from qsWorkDays
    :select count(date) from qsWorkDays where date between forms!myForm!txtStartDate and forms!myForm!txtEndDate

    now use qsWorkDaysCount joined to your data table (which also uses the date range) to calc your data.

  3. #3
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    1,516
    Hi there,

    Please see the related thread https://www.accessforums.net/showthr...287#post397287

    I think you need to use a dlookup as I explained in that thread that returns the first working date (checked=true) that is <= then the calculated calendar day (Calendar_Subweld:[Schedule].[Ship date]-[Subweld])

    Something like (you use it in a query):
    dlookup("[Work_Date]","[YourCalendarTable]","[Work_Date] <= #" & (
    [Schedule].[Ship date]-[Subweld]) & "# AND [Checked] = True")

    Cheers,
    Vlad

  4. #4
    jlgray0127 is offline Competent Performer
    Windows 7 64bit Access 2016
    Join Date
    Oct 2011
    Location
    Central Illinois
    Posts
    144
    Thank you, Vlad.
    I've tried this, but for all recoreds, it's giving me the first available work date on the calendar for all records... I'll keep playing with it, but to copy what you have above, it's stated as below...

    DLookUp("[Calendar Date]","[Calendar]","[Calendar Date] <= #" & ([BuildMaster].[PORTSDate]-[Category_Data].[Subweld]) & "# AND [Calendar].[Working] = True")

  5. #5
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    1,516
    Is it possible to upload a sample db with the tables involved (no need for data, just a few sample records) so I could have a look?

    Cheers,
    Vlad

  6. #6
    jlgray0127 is offline Competent Performer
    Windows 7 64bit Access 2016
    Join Date
    Oct 2011
    Location
    Central Illinois
    Posts
    144
    Here ya go! Thank you so much! I'm banging my head against the wall!
    Attached Files Attached Files

  7. #7
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    1,516
    Can you have a look at the qryMaster_BusinessDays and see if that is what you're looking for?

    Cheers,
    Vlad
    Attached Files Attached Files

  8. #8
    jlgray0127 is offline Competent Performer
    Windows 7 64bit Access 2016
    Join Date
    Oct 2011
    Location
    Central Illinois
    Posts
    144
    Vlad,
    It's still counting a 7 day week... one thing I didn't fully express, is that on the category_Date table, the days are adding together, to get the field [build time].I updated your query qryMaster_CalDates to show how they add together, and it counted a 7 day week. Not the dates from your working days query.
    I was running into the same issue trying to do it this way. I've attached with the updates to show how the days are added together to get to the total build time in your query.

    Thank you for taking the time and looking at this with me!

    The build for Category 7 Due on 04/18 looks like the below on the schedule:

    SOL Sub-Weld Oven Main Weld Ship to Paint/Machining Back From Paint Assembly/Test/PDI/Pack Build Complete
    03/22/18 3/27/2018 4/2/2018 4/2/2018 4/2/2018 4/11/2018 4/12/2018 4/18/2018
    Attached Files Attached Files

  9. #9
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    1,516
    Not sure I follow you. For example to get the first date (Assembly/Test/PDI/Back) you subtract 4 days from the PortsDate (4/18/2018-4 = 4/14/2018). That is the "calendar" date shown in qryMaster_CD query. Now because that is a Saturday we need the first work date before that, which is Friday the 13th. Why are you showing 4/12/2018 above?

    Cheers,
    Vlad

  10. #10
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    1,516
    Sorry, I think I saw my mistake, can you have a look at it now?

    Cheers,
    Vlad
    Attached Files Attached Files

  11. #11
    jlgray0127 is offline Competent Performer
    Windows 7 64bit Access 2016
    Join Date
    Oct 2011
    Location
    Central Illinois
    Posts
    144
    WOW! That is fantastic, my friend! You have no idea how long I've been beating my head against the wall with this! It looks perfect! Thank you so very much for your time and dedication! 5 star performance!

  12. #12
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    1,516
    Glad I could help, I've been in your shoes many many times😃
    Good luck with your projects!
    Cheers,
    Vlad

  13. #13
    jlgray0127 is offline Competent Performer
    Windows 7 64bit Access 2016
    Join Date
    Oct 2011
    Location
    Central Illinois
    Posts
    144
    After working with this some more once I pulled it into my database.... it takes several minutes to run and then, the window is not refreshing. You have to click on each value to see it in the datasheet....
    Thoughts? I tried to delete it from my database, then imported again, from the sample database you updated. It's still really really slow and produces the same results.
    It's almost as if the code continues to run and update over and over.... thoughts on what I might be able to do? I can't even get the data sheet to respond for me to validate it's calculating correctly.

    Edit:
    When running in the sample database, it runs in about 18 seconds... the database I imported it to, it takes about 6 minutes.
    It's also not picking up the Holidays from the Holiday Desc...

    I did see a statement in the module:
    ' 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.

    However, this is a production environment and would cost production days, missed shipments, and too much or too little staffing.... anyone have any idea how I can improve the below code? So much gratitude for asssitance!!!!

    Option Compare Database
    Option Explicit


    Public Function datNextWorkDate(datReferenceDate As Date, intDays As Integer) As Date
    datNextWorkDate = DLookup("[Calendar Date]", "[qryWorkDaysDESC]", "[Calendar Date] <= #" & (datReferenceDate - intDays) & "#")
    End Function


    Public Function vcAddBusinessDaysWithHolidayDESC(datStart As Date, lDays As Long) As Date
    Dim rHoliday As DAO.Recordset, vHolidays()
    Set rHoliday = CurrentDb.OpenRecordset("qryHolidaysDESC")
    vHolidays = rHoliday.GetRows(rHoliday.RecordCount)
    Set rHoliday = Nothing
    vcAddBusinessDaysWithHolidayDESC = dhSubtractWorkDaysA(lDays, datStart, vHolidays)
    End Function
    Function usbNetWorkdays(StartDate As Date, EndDate As Date) As Double


    Dim retval As Double


    If StartDate > EndDate Then
    Do While EndDate <= StartDate
    If WeekDay(EndDate) = 1 Or WeekDay(EndDate) = 7 Then
    EndDate = EndDate + 1
    Else
    retval = retval + 1
    EndDate = EndDate + 1
    End If
    Loop
    Else
    Do While StartDate <= EndDate
    If WeekDay(StartDate) = 1 Or WeekDay(StartDate) = 7 Then
    StartDate = StartDate + 1
    Else
    retval = retval + 1
    StartDate = StartDate + 1
    End If
    Loop
    End If


    If retval = 0 Then
    retval = 1
    End If


    usbNetWorkdays = retval - 1


    End Function
    Function dhFirstDayInWeek(Optional dtmDate As Date = 0) As Date
    ' Returns the first day in the week specified
    ' by the date in dtmDate.
    ' Uses localized settings for the first day of the week.
    If dtmDate = 0 Then
    ' Did the caller pass in a date? If not, use
    ' the current date.
    dtmDate = Date
    End If
    dhFirstDayInWeek = dtmDate - WeekDay(dtmDate, _
    vbUseSystem) + 1
    End Function
    Function dhLastDayInWeek(Optional dtmDate As Date = 0) As Date
    ' Returns the last day in the week specified by
    ' the date in dtmDate.
    ' Uses localized settings for the first day of the week.
    If dtmDate = 0 Then
    ' Did the caller pass in a date? If not, use
    ' the current date.
    dtmDate = Date
    End If
    dhLastDayInWeek = dtmDate - WeekDay(dtmDate, vbUseSystem) + 7
    End Function


    Public Function YearStart(WhichYear As Integer) As Date
    'It returns the first Monday of the specified year
    Dim WeekDay As Integer
    Dim NewYear As Date


    NewYear = DateSerial(WhichYear, 1, 1)
    WeekDay = (NewYear - 2) Mod 7 'Generate weekday index where Monday = 0


    If WeekDay < 4 Then
    YearStart = NewYear - WeekDay
    Else
    YearStart = NewYear - WeekDay + 7
    End If


    End Function
    Public Function WeekStart(WhichWeek As Integer, WhichYear As _
    Integer) As Date
    'It returns the first Monday of the specified week
    WeekStart = YearStart(WhichYear) + ((WhichWeek - 1) * 7)


    End Function


    Public Function NthDayOfWeek(Y As Integer, M As Integer, _
    n As Integer, DOW As Integer) As Date


    NthDayOfWeek = DateSerial(Y, M, (8 - WeekDay(DateSerial(Y, M, 1), _
    (DOW + 1) Mod 8)) + ((n - 1) * 7))


    End Function




    Public Function SpecificWeekday(ByVal D As Date, Optional _
    ByVal WhatDay As VbDayOfWeek = vbSaturday, _
    Optional GetNext As Boolean = True) As Date
    SpecificWeekday = (((D - WhatDay + GetNext) \ 7) - GetNext) * 7 + WhatDay
    End Function
    Function FirstOfNextMonth(datDATE As Date) As Date
    Dim dtm As Date
    dtm = datDATE
    FirstOfNextMonth = DateSerial(Year(dtm), Month(dtm) + 1, 1)
    End Function
    Function FirstOfThisMonth(datDATE As Date) As Date
    Dim dtm As Date
    dtm = datDATE
    FirstOfThisMonth = DateSerial(Year(dtm), Month(dtm), 1)
    End Function
    Function LastOfNextMonth(datDATE As Date) As Date
    LastOfNextMonth = DateAdd("m", 1, FirstOfNextMonth(datDATE)) - 1
    End Function
    Function LastOfThisMonth(datDATE As Date) As Date
    LastOfThisMonth = DateAdd("d", -1, FirstOfNextMonth(datDATE))
    End Function
    Public Function dhSubtractWorkDaysA(lngDays As Long, _
    Optional dtmDate As Date = 0, _
    Optional adtmDates As Variant) As Date
    'modified by Vlad to subtract dates
    ' 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 = dhPreviousWorkdayA(dtmTemp, adtmDates)
    Next lngCount
    dhSubtractWorkDaysA = dtmTemp
    End Function
    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 **************

  14. #14
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    1,516
    Hi Josh,

    Here is an updated sample, please replace the module with the new one and try to use the two new queries in sequence (qry1 then qry2) - make sure you import the local temporary tmpBuildDates table as well.

    The calculations will take a long time as there is a lot of stuff going on; can you try to put some criteria in the query to limit the number of records that need processing?

    Please try these changes and report back and we'll take it from there.

    Cheers,
    Vlad
    Attached Files Attached Files

  15. #15
    jlgray0127 is offline Competent Performer
    Windows 10 Access 2016
    Join Date
    Oct 2011
    Location
    Central Illinois
    Posts
    144
    Gicu,
    Sorry for the delay in getting back to you! We ended up putting this on hold for a bit, as we went through a long cycle of vacations and people not being here, who were key users.
    We found an issue, right around the 4th of July holiday, where the calculation was still using Holidays as a working day. Also, the time to update the dates, is still quite long, depending on how many records we are updating at once. If it's more than 5 or 10, it can take several minutes to run.
    Any assistance you can help with, is greatly appreciated! Thank you, again for your time looking at this!

Page 1 of 2 12 LastLast
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 4
    Last Post: 11-20-2018, 11:57 PM
  2. Replies: 1
    Last Post: 04-29-2016, 04:03 AM
  3. Replies: 6
    Last Post: 03-02-2016, 12:58 PM
  4. Replies: 3
    Last Post: 02-16-2016, 05:02 PM
  5. Replies: 1
    Last Post: 07-02-2014, 08:48 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums - Senior Forums