Add hours to a given date and time (1 Viewer)

[Hudas]

Hi Good Day,

I need to add hours to a given date and time but the condition is it needs to skip the weekends ,holidays and, non working hours.

Example:

Shift Start: 08:00 AM
Shift End: 5:00 PM
Add 3 hours to 10/7/2016 3:30:00 PM

The result should be 10/10/2016 9:30:00 AM

Any help is greatly appreciated.

Thank you
Jun

 

[Uncle Gizmo]

You might find this YouTube video:- MS Access - Add Time to a Date:- https://youtu.be/D_magBM3rOY helpful as it demonstrates how to add hours I explain how it works this method accesses the numerical value of the date directly. I'm not sure whether I should promote this method of doing it because I read somewhere recently that this is not the recommended way to handle dates. General advice is to use the MS Access built-in functions.

 

[Cronk]

The built in Access function to add/subtract time to a date, referred in the previous post, is DateAdd

Use the WeekDay to determine weekends. As to holidays you'll have to define which dates are to be excluded.

There's been any number of posts on this form (search) on similar aspects of what you want to do.

 

[Cronk]

The built in Access function to add/subtract time to a date, referred in the previous post, is DateAdd

Use the WeekDay to determine weekends. As to holidays you'll have to define which dates are to be excluded.

There's been any number of posts on this form (search) on similar aspects of what you want to do.

 

[Hudas]

So I'm trying to create a function that will give me what I need but I'm stuck. So far this is what I have. I tried searching google as well as this forums but I don't see a solution near to what I needed.

This code will get the start date and time considering the Holidays, Weekends, and Time that falls after the shift ends.

Public Function NewBusinessDay(ActualStartDateTime As Date, ShiftEnd As Date) As Date
 Dim ActualStartDate As Date
Dim ActualStartHour As Date
Dim StartDate0 As Date
Dim StartHour0 As Date
     ActualStartDate = DateValue(ActualStartDateTime)
    ActualStartHour = TimeValue(ActualStartDateTime)
    StartDate0 = ActualStartDate
    
    If ActualStartHour >= ShiftEnd Or Weekday(StartDate0, vbSaturday) <= 2 Or Not IsNull(DLookup("[dteDate]", "tbl_Holidays", "[dteDate] = #" & Int(StartDate0) & "#")) Then ''ActualStartHour is greater than or equal to ShiftEnd ~ Date falls on a weekend ~ Date falls on a holiday THEN get the next business day
        StartDate0 = StartDate0 + 1
        Do While Not IsNull(DLookup("[dteDate]", "tbl_Holidays", "[dteDate] = #" & Int(StartDate0) & "#")) Or Weekday(StartDate0, vbSaturday) <= 2
            StartDate0 = StartDate0 + 1
        Loop
    End If
    
    NewBusinessDay = StartDate0
    
End Function

Public Function NewBusinessHour(ActualStartDateTime As Date, StartDate0 As Date, ShiftStart As Date) As Date
 Dim ActualStartDate As Date
Dim ActualStartHour As Date
Dim StartHour0 As Date
     ActualStartDate = DateValue(ActualStartDateTime)
    ActualStartHour = TimeValue(ActualStartDateTime)
    
    If ActualStartDate = StartDate0 Then ' If ActualStartDate changes then StartHour should change depending on certain conditions
        If ActualStartHour < ShiftStart Then
            StartHour0 = ShiftStart
        Else
            StartHour0 = ActualStartHour
        End If
    ElseIf ActualStartDate <> StartDate0 Then
        StartHour0 = ShiftStart
    End If
    
    NewBusinessHour = StartHour0
    
End Function

I'm having trouble on the condition when I add an hour to the time the result will fall after the ShiftEnd and the remaining minutes should be added on the next business day again.. Below is currently what I have...

Any help is greatly appreciated.

Public Sub AddHours()
 Dim ActualStartDateTime As Date
Dim HoursToAdd As Integer
Dim ShiftStart As Date
Dim ShiftEnd As Date
Dim StartDateHour0 As Date
Dim StartDate0 As Date
Dim StartHour0 As Date
Dim DateHourKounter As Date
Dim Kounter0 As Integer
Dim RemainingTime As Date
Dim DueDateHour As Date
    
    ActualStartDateTime = #10/7/2016 4:47:58 PM#
    HoursToAdd = 3
    ShiftStart = #8:00:00 AM#
    ShiftEnd = #5:00:00 PM#
    
    StartDate0 = NewBusinessDay(ActualStartDateTime, ShiftEnd)
    StartHour0 = NewBusinessHour(ActualStartDateTime, StartDate0, ShiftStart)
    StartDateHour0 = StartDate0 + StartHour0
    
    Kounter0 = 1
    Do While Kounter0 <= HoursToAdd
        DateHourKounter = DateAdd("h", 1, StartDateHour0)
            If TimeValue(DateHourKounter) > ShiftEnd Then
                Remaining = TimeValue(DateHourKounter) - ShiftEnd
                StartDate0 = NewBusinessDay(DateHourKounter, ShiftEnd)
                StartDateHour0 = StartDate0 + ShiftStart
            End If
        Kounter0 = Kounter0 + 1
    Loop
    
    DueDateHour = DateHourKounter
    
End Sub

 

[jdraw]

See if this post provides some insight.

 

[Hudas]

Thank you jDraw, the link you shared is the same with the my NewBusinessDay Function taking into consideration the Holiday, and Weekend. My problem is more related on adding an hour(integer) but it should be added during business hours only which is 8:00 AM to 5:00 PM only. So the result should also be within the business hours.

My main concern is when I try to add one hour to a time and the result is already greater than the shiftend time so it should carried over to the next day.

Example:

Given Hour = 04:47:36 PM

If I add one hour to it the result will be 05:47:36 PM which is greater than the shiftEND (5:00:00 PM) so the remaining 00:47:36 should be added to the next day and the result should be 08:47:36 AM. I added the remaining to the shift start which is 08:00:00 AM.

Thank you very much
:banghead::banghead: I really don't know what to do now.

 

[TJPoorman]

This function I threw together works for your example. It would need to be modified to lookup the date to see if it is a holiday. You would need to keep a table of holidays for this.

Public Function AddHours(datStartDate As Date, intHours As Integer) As Date
Const intDayStart = 8
Const intDayEnd = 17
 
Do While intHours > 0
    datStartDate = DateAdd("h", 1, datStartDate)
   
    If Weekday(datStartDate, vbMonday) <= 5 Then
        If Hour(datStartDate) >= intDayStart And Hour(datStartDate) < intDayEnd Then
            intHours = intHours - 1
        End If
    End If
Loop
 
AddHours = datStartDate
End Function

 

[TJPoorman]

The following would lookup holidays, but be warned the DLookup will slow the function down

Public Function AddHours(datStartDate As Date, intHours As Integer) As Date
Const intDayStart = 8
Const intDayEnd = 17
 
Do While intHours > 0
    datStartDate = DateAdd("h", 1, datStartDate)
   
    If Weekday(datStartDate, vbMonday) <= 5 Then
        If Hour(datStartDate) >= intDayStart And Hour(datStartDate) < intDayEnd Then
            If Nz(DLookup("ID", "tblHolidays", "MyHoliday = #" & CDate(Fix(datStartDate)) & "#"), 0) = 0 Then
                intHours = intHours - 1
            End If
        End If
    End If
Loop
 
AddHours = datStartDate
End Function

 

[Hudas]

Thank you! Thank you! TjPoorman....

If I add 1 hour to 04:57:36 PM and surely the result is greater than intdayEnd , would it be possible to add the remaining minutes to the next day¿

Example

Add 1 hour to 10/13/2016 04:57:36 PM, since 5:00:00 PM is the dayEnd so the result should be 10/14/2016 08:57:36 AM because the day start is 08:00:00

Thank you

 

[TJPoorman]

Did you even try the function before replying? The result of your example is exactly what you are looking for.

 

[Hudas]

My Sincere apologies TJPoorman... Yes it does exactly what I want. Thank you so much for everyones help.