446,400 Members | 1,021 Online
Need help? Post your question and get tips & solutions from a community of 446,400 IT Pros & Developers. It's quick & easy.

# Access Module(modify) to account for Holidays

 P: 1 I found this module : See below to calculate elapsedtime ... I am just learning this. If any anyone could assit on how i could modfiy to calculate time elapsed not including a holiday(s) for e.g 09/03/07. Your help would highly appreciated ublic Function WorkdayTime(BeginTime As Date, EndTime As Date) As Single ' This function will return the elapsed time (in minutes) between the ' BeginTime and EndTime date values. It filters out time outside of ' business hours (8:00 am to 5:00 pm, Monday through Friday). ' ' Basically, go through each day in the elapsed time and subtract fourteen ' hours (900 min.) if the day is a weekday, or 24 hours (1440 min.) if the ' day is on the weekend. Dim NewEnd As Date ' Temporary variable for the End Time Dim ET As Double ' Elapsed time (in minutes) Dim DOW As Integer ' Day of the Week ' Change these constants according to your own business hours Const WEEKDAYOFFHRS = 840 ' 15 hrs. * 60 minutes Const WEEKENDOFFHRS = 1440 ' 24 hrs. * 60 minutes Const FIRSTWORKDAY = vbMonday ' 1st day of the work week Const WORKDAYS = 5 ' No. of days in a work week ' First, calculate initial elapsed time (in minutes) ET = DateDiff("n", BeginTime, EndTime) ' Set the temporary Newend to EndTime NewEnd = EndTime ' Loop while the end time is not on the same day as the begin time Do While DateDiff("d", BeginTime, NewEnd) > 0 ' Get the day of the week for the new end time DOW = WeekDay(NewEnd, FIRSTWORKDAY) ' If the DOW is Sat. or Sun., subtract 1440 minutes from the elapsed Time ' Otherwise, subtract 900 minutes. If DOW > WORKDAYS Then ET = ET - WEEKENDOFFHRS Else ET = ET - WEEKDAYOFFHRS ' Subtract a day from the new end time NewEnd = DateAdd("d", -1, NewEnd) Loop ' This routine doesn't work correctly if BeginDate is on a ' non-work day. It'll end up with a negative number, so ' if ET < 0 then just return the actual elapsed time. If ET < 0 Then WorkdayTime = DateDiff("n", BeginTime, EndTime) Else WorkdayTime = ET End If End Function Sep 5 '07 #1