Adding Hours (1 Viewer)

[Sean75db]

Hello everyone who reads this,

I work for a bank and have built a workflow tool using access, i have a section where i have a start date/time and I need to add a certain amount of hours to that start date/time to give my users the due time for a loan.
So our operation hours are 8 am to 5 pm, at this time we do not take time out for lunch hour. We have either 5, 8 , 10 , 12, 14 and 16 hour loans.

example: if a loan comes in at 10:00 am and is a 5 hour then it would be due at 3:00 pm, or if it is a 10 hour loan then it would be due at 9:00 am the next business day.

I have a Module i put together for this and it works perfectly except for when I have a 16 hour loan that is due 2 days from start.

Right now if i have a 16 hour loan it will add 1 or 2 hours to the due time,
So if i get a loan at 10:00 am and it is a 16 hour loan then it should be due at 5 pm the next day or 8 am the day after that, but i am getting an extra hour so it gives me 9:00 am. basically with the 16 hour loans i am not getting consistent results.

This is the coding i have for running my module

If IsNull([Date_Complete_Package_Received]) = False Then
        If SLA_Time = 5 Then
            Me.Date_and_Time_Complete_Package_DUE = AddWorkHours(5, Date_Complete_Package_Received)
        ElseIf SLA_Time = 8 Then
            Me.Date_and_Time_Complete_Package_DUE = AddWorkHours(8, Date_Complete_Package_Received)
        ElseIf SLA_Time = 10 Then
            Me.Date_and_Time_Complete_Package_DUE = AddWorkHours(10, Date_Complete_Package_Received)
        ElseIf SLA_Time = 12 Then
            Me.Date_and_Time_Complete_Package_DUE = AddWorkHours(12, Date_Complete_Package_Received)
        ElseIf SLA_Time = 14 Then
            Me.Date_and_Time_Complete_Package_DUE = AddWorkHours(14, Date_Complete_Package_Received)
        ElseIf SLA_Time = 16 Then
            Me.Date_and_Time_Complete_Package_DUE = AddWorkHours(16, Date_Complete_Package_Received)
        End If
    ElseIf IsNull([Date_Complete_Package_Received]) = True Then
        Me.SLA_Time = Null
    End If

This is the Module coding

Public Function AddWorkHours(AddHours As Double, StartDateTime As Date) As Date
Dim StartDate As Date
Dim StartHour As Integer
Dim StartMinute As Integer
Dim TodaysHours As Integer
Dim HoursLeftToAdd As Integer
Dim DaysToAdd As Integer
Dim ExtraHours As Integer
Dim i As Integer
Dim NextDay As Date
Dim x As Integer

StartDate = CDate(DatePart("m", StartDateTime) & "/" & DatePart("d", StartDateTime) & "/" & DatePart("yyyy", StartDateTime))
StartHour = DatePart("h", StartDateTime)
StartMinute = DatePart("n", StartDateTime)
TodaysHours = 17 - StartHour
'Check to see how many days we are adding
If AddHours - TodaysHours < 0 Then 'ends in today
    AddWorkHours = DateAdd("h", AddHours, StartDateTime)
    Exit Function
End If
HoursLeftToAdd = AddHours - TodaysHours
DaysToAdd = HoursLeftToAdd \ 8 + 1 'Will return lowest integer # of days
x = 0
For i = 1 To DaysToAdd
    
    x = x + 1
    
    NextDay = DateAdd("d", x, StartDate)
    If Weekday(NextDay) = 1 Or Weekday(NextDay) = 7 Or DCount("*", "Holidays", "[Holiday] = " & NextDay) > 0 Then i = i - 1
Next i
AddWorkHours = DateAdd("n", StartMinute, DateAdd("h", HoursLeftToAdd Mod 8, CDate(NextDay & " 8:00 AM")))
'If DatePart("h", AddWorkHours) >= 12 Then AddWorkHours = DateAdd("h", 1, AddWorkHours) 'Add lunch hour

End Function

 

[TJPoorman]

I'm not quite sure I fully understand what you're looking for, but I did run this function and got what appears to be correct information for what you're looking for:

Public Const OpenHour = 8    'Use this constant to set the opening time of the branch
Public Const CloseHour = 17    'Use this constant to set the closing time of the branch

Public Function AddWorkHours(AddHours As Integer, StartDateTime As Date) As Date
Dim i As Integer
Dim datNewDate As Date

datNewDate = StartDateTime
For i = 0 To AddHours
    datNewDate = DateAdd("h", 1, datNewDate)
    If Hour(datNewDate) > CloseHour Then
        datNewDate = CDate(Fix(datNewDate + 1) & " " & OpenHour & ":00:00")
    End If
    
    If DatePart("w", datNewDate, vbMonday) > 5 Then
        datNewDate = DateAdd("d", 8 - DatePart("w", datNewDate, vbMonday), datNewDate)
    End If
Next i

AddWorkHours = datNewDate
End Function

Also your calling procedure can be simplified dramatically. Like this:

If IsNull([Date_Complete_Package_Received]) = False Then
    Me.Date_and_Time_Complete_Package_DUE = AddWorkHours(SLA_Time, Date_Complete_Package_Received)
Else
    Me.SLA_Time = Null
End If