Calculate Business Hours

20 pts.
Tags:
Microsoft Access
Microsoft Access 2007
VBA
I found a VBA code that fits the program I'm trying to create but I'm having a difficult time locating the 12-1 lunch break so I can make it straight time. Listed below is the code. Function CalculateDownTime(StartTime As Date, EndTime As Date) As Double Dim Result As Double, EndDay As Date Result = 0 If Not IsWorkTime(StartTime) Then Call Move2Next(StartTime) Do While StartTime < EndTime EndDay = CalculateEnd(StartTime) If EndTime < EndDay Then Result = Result + DateDiff("n", StartTime, EndTime) / 60 Else Result = Result + DateDiff("h", StartTime, EndDay) End If Call Move2Next(StartTime) Loop CalculateDownTime = Result End Function Sub Move2Next(DateX As Date) If Weekday(DateX, 2) = 5 And Hour(DateX) >= 13 And Hour(DateX) <= 23 Then DateX = DateSerial(year(DateX), Month(DateX), Day(DateX)) DateX = DateAdd("d", 3, DateX) DateX = DateAdd("h", 8, DateX) ElseIf Weekday(DateX, 2) = 6 Then DateX = DateSerial(year(DateX), Month(DateX), Day(DateX)) DateX = DateAdd("d", 2, DateX) DateX = DateAdd("h", 8, DateX) ElseIf (Weekday(DateX, 2) = 7) Or (Hour(DateX) >= 13 And Hour(DateX) <= 23) Then DateX = DateSerial(year(DateX), Month(DateX), Day(DateX)) DateX = DateAdd("d", 1, DateX) DateX = DateAdd("h", 8, DateX) ElseIf Hour(DateX) >= 0 And Hour(DateX) < 8 Then DateX = DateSerial(year(DateX), Month(DateX), Day(DateX)) DateX = DateAdd("h", 8, DateX) ElseIf Hour(DateX) >= 8 And Hour(DateX) < 13 Then DateX = DateSerial(year(DateX), Month(DateX), Day(DateX)) DateX = DateAdd("h", 13, DateX) End If End Sub Function IsWorkTime(DateX As Date) As Boolean If Weekday(DateX, 2) <> 6 And Weekday(DateX, 2) <> 7 And _ ((Hour(DateX) >= 8 And Hour(DateX) <= 11) Or (Hour(DateX) >= 13 And Hour(DateX) <= 16)) Then IsWorkTime = True Else IsWorkTime = False End If End Function Function CalculateEnd(DateX As Date) As Date Dim Result As Date Result = DateSerial(year(DateX), Month(DateX), Day(DateX)) If Hour(DateX) < 12 Then Result = DateAdd("h", 12, Result) Else Result = DateAdd("h", 17, Result) End If CalculateEnd = Result End Function Any help would be appreiciated. Thanks

Answer Wiki

Thanks. We'll let you know when a new response is added.

I think maybe the clause

((Hour(DateX) >= 8 And Hour(DateX) <= 11) Or (Hour(DateX) >= 13 And Hour(DateX) <= 16))

in Function IsWorkTime is counting time between 8 & 11 and between 1 &
4 as work time. So maybe just changing the 11 to 12 will work. But I can’t be sure because it is REALLY hard to read the code in this format.

Discuss This Question: 1  Reply

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
  • carlosdl
    Please use the editor's code tool to post your code.
    70,220 pointsBadges:
    report

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Thanks! We'll email you when relevant content is added and updated.

Following