Calculating Business Hours : Orientation and error correction required 2

[DajOne]

Good day to all.

(Posted yesterday in the wrong forum, put a note to refer here).

I have studied thread181-51747: Is calculating BUSINESS HOURS possible...?, thread705-1207464: Calculate business hours between two times, FAQ181-261: Calculate working days between two dates and anything related to the calculation of business hours, especially by Michael Red. Unfortunately, VBA is unknown to me and I am not a programmer. I got confused as to what code version was the appropriate one for our needs.

My company requires a way to calculate working hours and minutes between dates while removing weekends and holidays (coffee breaks and lunch calculation are not required). The results are to be stored in a separate table.

Assuming that:

Table:
"tblHolidays" contains [holidate] and [holiname] fields where [holiname] is "text" and [holidate] is "GeneralDate" to capture the HH:MM
"tblDates" contains [stdt] (StartDate) and [enddt] (End Date) where both fields are "GeneralDate"
The code below is saved in a module named "WH" (for working hours)
When I activate this code, it required a macro name, which I created to run this code: basDlyHrs («StDt», «EndDt») however an error occurs (cant find "stdt"

My questions are as follow:

Will the code below provide both business hours and min?
If yes, what am I doing wrong?


I do am sorry in advance if this is not clear enough however I think I did my best after a full day in trying to make this work. I envy your knowledge..

Thanks in advance



Public Function basDlyHrs(StDt As Date, EndDt As Date) As Double

'Michhael Red 1/1/2003 Working Hours?
'Tek-Tips thread705-449121 for "Chargers"

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim Idx As Long
Dim StrtTim As Date
Dim EndTim As Date
Dim dtSt As Date
Dim dtEnd As Date
Dim TheDate As Date
Dim DlyHrs As Single

Dim strCriteria As String
Dim strSql As String

StrtTim = #8:30:00 AM#
EndTim = #5:00:00 PM#
DlyHrs = DateDiff("n", StrtTim, EndTim)

dtSt = Format(StDt, "Short Date")
dtEnd = Format(EndDt, "Short Date")

'Create an Array to hold the Time for Each Day
Dim MyDates() As MyDtHrsType
'Resize array for each DAY
' ReDim MyDates(dtEnd - dtSt + 1)

'Get Holidates
Set dbs = CurrentDb

strCriteria = "(HoliDate Between " & Chr(35) & dtSt & Chr(35) & _
" AND " & Chr(35) & dtEnd & Chr(35) & ")"

strSql = "Select Holidate "
strSql = strSql & "from tblHolidates "
strSql = strSql & "Where "
strSql = strSql & strCriteria & ";"

Set rst = dbs.OpenRecordset(strSql, dbOpenDynaset)

'Set Daily Hours for each Date
ReDim MyDates(0) 'Initalize the array
TheDate = dtSt
Idx = 1
While TheDate <= dtEnd
ReDim Preserve MyDates(UBound(MyDates) + 1)
'Insert the date
MyDates(Idx).MyDate = DateAdd("d", Idx - 1, dtSt)
'Check For Sat / Sun
If (Weekday(MyDates(Idx).MyDate) = vbSaturday Or _
Weekday(MyDates(Idx).MyDate) = vbSunday) Then
'Zero Hours for Weekend days
MyDates(Idx).MyHrs = 0
Else
'Check for First & last Days as Well as Holidates
If (Idx <> 1 Or Idx <> UBound(MyDates)) Then
'Not first / Last, Default Hrs to Daily Schedual
MyDates(Idx).MyHrs = DlyHrs
End If

End If
Idx = Idx + 1
TheDate = MyDates(Idx - 1).MyDate
Wend

'Initalize Start and End Date Times
MyDates(1).MyHrs = DateDiff("n", TimeValue(StDt), EndTim)
MyDates(UBound(MyDates)).MyHrs = DateDiff("n", StrtTim, TimeValue(EndDt))

Idx = 1
While Idx <= UBound(MyDates)
basDlyHrs = basDlyHrs + MyDates(Idx).MyHrs
Idx = Idx + 1
Wend

Do While Not rst.EOF
Idx = 1
While Idx <= UBound(MyDates)
If (MyDates(Idx).MyDate = rst!Holidate) Then
MyDates(Idx).MyHrs = 0
End If
Idx = Idx + 1
Wend
rst.MoveNext
Loop

basDlyHrs = basDlyHrs / 60

Set dbs = Nothing

End Function

 

[SkipVought]

It is always helpful to know what you are working with.

Date/Time values are NUMBERS, in units of DAYS. Right now, in North Texas, the DateTime value is 39504.3305263889, meaning that .32856 of the day has passed...
[tt]
.3305263889 Days * 24 Hours/Day or 7.932633334 Hours

.932633334 Hours * 60 Minutes/Hour or 55.95800004 Minutes

.95800004 Minutes * 60 Seconds/Minute or 57.4800024 Seconds

Then...

.3305263889 Days FORMATTED as HH:MM:SS

7:55:57
[/tt]
Just some stuff to understand as you proceed.

The DATE part is just days since 1/1/1900, more or less.

Skip,
[sub]
I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent![/sub]

 

[ck1999]

Dajone,

take a look at this code

Public Function basDlyHrs(StDt As Date, EndDt As Date) As Double

    'Michhael Red   1/1/2003   Working Hours?
    'Tek-Tips thread705-449121 for "Chargers"

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim Idx As Long
    Dim StrtTim As Date
    Dim EndTim As Date
    Dim dtSt As Date
    Dim dtEnd As Date
    Dim TheDate As Date
    Dim DlyHrs As Single

    Dim strCriteria As String
    Dim strSql As String

    StrtTim = #8:30:00 AM#
    EndTim = #5:00:00 PM#
    DlyHrs = DateDiff("n", StrtTim, EndTim) / 60

    dtSt = Format(StDt, "Short Date")
    dtEnd = Format(EndDt, "Short Date")

    'Create an Array to hold the Time for Each Day
  '  Dim MyDates() As MyDtHrsType
    'Resize array for each DAY
'    ReDim MyDates(dtEnd - dtSt + 1)

    'Get Holidates
    Set dbs = currentdb

    strCriteria = "(HoliDate Between " & Chr(35) & dtSt & Chr(35) & _
                   " AND " & Chr(35) & dtEnd & Chr(35) & ")"

    strSql = "Select Holidate "
    strSql = strSql & "from tblHolidates "
    strSql = strSql & "Where "
    strSql = strSql & strCriteria & ";"

    Set rst = dbs.OpenRecordset(strSql, dbOpenDynaset)
     
     Dim holidaycount
     holidaycount = 0
     rst.MoveFirst
     Do While Not rst.EOF
        If (Weekday(rst("holidate"), vbMonday) > 5) Then
           holidaycount = holidaycount + 1
        End If
         rst.MoveNext
    Loop
    
    ' next line from [URL unfurl="true"]http://www.pacificdb.com.au/MVP/Code/Dates.htm[/URL]
    datecount = DateDiff("d", dtSt, dtEnd) - DateDiff("ww", dtSt, dtEnd, 1) * 2 - IIf(Weekday(dtEnd, 1) = 7, IIf(Weekday(dtSt, 1) = 7, 0, 1), IIf(Weekday(dtSt, 1) = 7, -1, 0)) + 1
   
    datecount = datecount - holidaycount

    basDlyHrs = datecount * DlyHrs

    Set dbs = Nothing

End Function

This codes shortens and possibly less complicates the funrtion

this function now returns total minutes. You should be able then to use mod to determine hours and minutes from there
for example

minutes = basdlyhours mod 60
hours = (basdlyhours - minutes) / 60 ' I thought there was a div function but could not find it in help

ck1999

 

[PHV]

I thought there was a div function but could not find it in help
you meant this ?
hours = basdlyhours \ 60

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[ck1999]

PHV,

I was looking to where it would only the whole number without the decimals.

ck1999

 

[ck1999]

Did not realize there was a difference in the slant of the \

I did not know about that!

ck1999

 

[EBGreen]

If you only want the Int part then:

hours = Int(basdlyhours \ 60)

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]

 

[ck1999]

Place this code in a module. This will loop through your current table of dates and report back in a third field the number of minutes. You mentioned another table but did not give the specifics so you can alter this code and have it put the data in another table.

set db = currentdb

set rs=db.openrecordset("tblDates")

rs.movefirst
do while not rs.eof

   rs.edit
   rs("Field3")=basDlyHrs(rs("stdt"),rs("endt")
   rs.update
rs.movenext
loop

set rs=nothing
set db = nothing

if you wanted to you could have rs("fields") = basDlyHrs(rs("stdt"),rs("endt") \ 60 & " Hours" & basDlyHrs(rs("stdt"),rs("endt") mod 60 & " Minutes"

if you wanted a string instead of numbers

ck1999

 

[SkipVought]

hours = basdlyhours \ 60

is equivalent to

hours = Int(basdlyhours / 60)

Skip,
[sub]
I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent![/sub]