calculate time elapsed

[Guest]

Hello,
I am using the function indicated below (which I found on one of these
threads), but I'm getting small pop-up window with two dates on it and an OK
button. I click OK and the function continues to run, but then it happens
again and again and again. I think it might be because some EndDate values
are null. Can someone help me modify this function so that it stops doing
this?
Thanks

 

[Guest]

Here is the function I'm referring to.

Function Minus_Non_Work_Time(BegDate As Variant, EndDate As Variant) As
Integer
' Note that this function does not account for holidays.
' MODIFIED FROM CODE FOUND ON DEV ASHISH'S SITE
' ASSUMES A PROJECT CANNOT BE ENDED ON A WEEKEND
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
Dim oddweekend As Integer
Dim weekends As Integer
Dim Days As Integer


BegDate = DateValue(BegDate)


EndDate = DateValue(EndDate)
' compute the number of full 7 day weeks
WholeWeeks = DateDiff("w", BegDate, EndDate)


' now add remaining days, skipping sat & sun
DateCnt = DateAdd("ww", WholeWeeks, BegDate)
EndDays = 0
oddweekend = 0


Do While DateCnt < EndDate
If Format(DateCnt, "ddd") <> "Sun" And _
Format(DateCnt, "ddd") <> "Sat" Then
EndDays = EndDays + 1
Else ' ADD 24 HRS FOR EACH WEEKEND DAY
oddweekend = oddweekend + 24
MsgBox DateCnt & " " & EndDate


End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
' number of working days



Days = WholeWeeks * 5 + EndDays
'compute non-working hours




Minus_Non_Work_Time = (Days * 15) + (WholeWeeks * 48) + oddweekend


End Function

 

[Douglas J. Steele]

Since you don't have a duration if one (or both) of the dates are Null, have
the function return 0 in that case.

Function Minus_Non_Work_Time(BegDate As Variant, EndDate As Variant) As
Integer
' Note that this function does not account for holidays.
' MODIFIED FROM CODE FOUND ON DEV ASHISH'S SITE
' ASSUMES A PROJECT CANNOT BE ENDED ON A WEEKEND
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
Dim oddweekend As Integer
Dim weekends As Integer
Dim Days As Integer

If IsNull(BegDate) Or IsNull(EndDate) Then
Minus_Non_Work_Time = 0
Else
BegDate = DateValue(BegDate)

EndDate = DateValue(EndDate)
' compute the number of full 7 day weeks
WholeWeeks = DateDiff("w", BegDate, EndDate)

' now add remaining days, skipping sat & sun
DateCnt = DateAdd("ww", WholeWeeks, BegDate)
EndDays = 0
oddweekend = 0

Do While DateCnt < EndDate
If Format(DateCnt, "ddd") <> "Sun" And _
Format(DateCnt, "ddd") <> "Sat" Then
EndDays = EndDays + 1
Else ' ADD 24 HRS FOR EACH WEEKEND DAY
oddweekend = oddweekend + 24
MsgBox DateCnt & " " & EndDate


End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
' number of working days

Days = WholeWeeks * 5 + EndDays
'compute non-working hours

Minus_Non_Work_Time = (Days * 15) + (WholeWeeks * 48) + oddweekend
End If

End Function

 

[Guest]

Thanks. But it is not working. I noticed that the first date that appears
on the error message is always a saturday or sunday. I do remember reading
that this function assumed that no dates were entered during non-working
hours. How can I fix this?

 

[Douglas J. Steele]

Nothing pops out as causing an infinite loop. You'll have to try
single-stepping through the function with date values that are giving you
problems. (In other words, debug the function before you use it in the
query)