Working hours & holidays problem (1 Viewer)

[Psiren17]

Hi - i got the following piece of code from this site and it works brilliantly for calculating working hours only and removing weekend days from the calculation.

However - the removing holidays bit doesnt work and i cant figure out why! I'm not great with the VBA side of things, i can adapt code but not write it myself.

Anyone have any ideas why its not removing the holidays? I have a table called Holidays with just one field called HolDate as needed by the code and the dates are in the format 01/01/2007.

Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossHours As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayhours As Single
Dim EndDayhours As Single

NetWorkhours = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day

WorkDayStart = DateValue(dteEnd) + TimeValue("06:30am")
WorkDayend = DateValue(dteStart) + TimeValue("03:30pm")
StartDayhours = DateDiff("n", dteStart, WorkDayend)
EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours

If StartDayhours < 0 Then
StartDayhours = 0
End If
If EndDayhours > 8 Then
EndDayhours = 8
End If

'Calculate total hours and days between start and end times

intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = DateDiff("n", (dteStart), (dteEnd))

'count number of weekend days and holidays (from a table called "Holidays" that lists them)
For i = 0 To intGrossDays
dteCurrDate = dteStart + i
If Weekday(dteCurrDate, vbSaturday) < 3 Then
nonWorkDays = nonWorkDays + 1
Else
If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then
nonWorkDays = nonWorkDays + 1
End If
End If
Next i

'Calculate number of work hours

Select Case intGrossDays
Case 0
'start and end time on same day
NetWorkhours = intGrossHours
Case 1
'start and end time on consecutive days
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
Case Is > 1
'start and end time on non consecutive days
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 8
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours

End Select

 

[RuralGuy]

Are you using US dates? Return Dates in US #mm/dd/yyyy# format

 

[Psiren17]

This could very well be the problem! I am using UK date format - dd/mm/yyyy - i didnt realise that Access assumes dates are US format.

How would i use the code shown in the link you posted? Apologies for my ignorance!

 

[RuralGuy]

If Not IsNull(DLookup("[HolDate]", "Holidays", _
"[HolDate] = " & Format(Int(dteCurrDate), _
"\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then

 

[lightray]

If Not IsNull(DLookup("[HolDate]", "Holidays", _
"[HolDate] = " & Format(Int(dteCurrDate), _
"\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then

Hi RuralGuy,

would this happen on a open recordset as well? In NZ we use dd/mm/yyyy
format as well. This is part of my modified Arvin Meyer module. When I add a new holiday to the holiday table it gets counted (shouldn't), however it seems records for xmas and new year are???
any thoughts appreciated

            rst.FindFirst "[HoliDate] = #" & StartDate & "#"
            If Weekday(StartDate) <> vbSunday And Weekday(StartDate) <> vbSaturday Then
            If rst.NoMatch Then intCount = intCount + 1
            End If

 

[RuralGuy]

YES, try:

rst.FindFirst "[HoliDate] = " Format(StartDate, "\#mm\/dd\/yyyy\#;;;\N\u\l\l")

Notice that the Format() function will add the octothorps "#".

 

[lightray]

Will try that out and post back, many thanx

 

[lightray]

Thanks RuralGuy, that was just what I needed. Worked a treat! I had the format already setup as a global constant, but didn't realise I needed it here. So the final solution was;

            rst.FindFirst "[HoliDate] = " & Format$(StartDate, JetDateFmt)

            If Weekday(StartDate) <> vbSunday And Weekday(StartDate) <> vbSaturday Then

            If rst.NoMatch Then intCount = intCount + 1

            End If

Where JetDateFmt is a global constant;

Option Compare Database

Option Explicit



Global Const JetDateTimeFmt = "\#mm\/dd\/yyyy hh\:nn\:ss\#;;;\N\u\l\l"

Global Const JetDateFmt = "\#mm\/dd\/yyyy\#;;;\N\u\l\l"

Which is credit to the forum also... picked it up here I think? ...

Thanks again for the input

 

[RuralGuy]

Much easier to read. Good job.

 

[lightray]

This was a great help to me today.. Thanks for the post and thanks for the reply, RuralGuy

 

[RuralGuy]

Any time. These older threads are always relevant.