My calculation comes up with 4/28/2006 because we have Good Friday as a
Holiday.
But at least I think my calculation is correct.
200 hrs estimated with 75% remaing = 150 hrs.
person 1 @ 20% is 1.6 hrs per day
same for 2 through 5
5 people @ 1.6 hrs per day = 8 hrs per day
150 hrs / 8 hrs per day = 18.75 hrs
Rounded to calculate working days is 19 days
So, once you have calculated the number of working days, you can use this
function to determine the end date. Note this function uses a holiday
calendar to check for non working days Monday through Friday. Mine has only
a date, and a description.
You can set one up yourself and modify the table and field name to use yours.
For this function, you pass it the first date and the number of days, and it
returns the end date as a date. Just for fun, I am including an additional
function CalcWorkDays. You pass it a begin date and an end date and it
returns the number of working days.
Public Function AddWorkDays(OriginalDate As Date, DaysToAdd As Integer) As
Date
'D Hargis
'OriginalDate = First Day to calculate number of working days from
'DaysToAdd = Number of Working Days to add to OriginalDate
'Returns the date that is the last working day for the number of days
'To look back, pass a negative number of days
'If 0 is entered, the current date is returned
Dim intDayCount As Integer
Dim dtmReturnDate As Date
Dim intAdd As Integer
'Determine whether to add or subtract
Select Case DaysToAdd
Case Is >= 1
intAdd = 1
Case Is = 0
AddWorkDays = OriginalDate
Exit Function
Case Else
intAdd = -1
End Select
intDayCount = 0
Do While True
If Weekday(OriginalDate, vbMonday) <= 5 Then 'It is a weekday
If IsNull(DLookup("[HolDate]", "Holidays", _
"[HolDate] = #" & OriginalDate & "#")) Then
intDayCount = intDayCount + intAdd
dtmReturnDate = OriginalDate
End If
End If
If intDayCount = DaysToAdd Then
Exit Do
End If
OriginalDate = DateAdd("d", intAdd, OriginalDate)
Loop
AddWorkDays = dtmReturnDate
End Function
Function CalcWorkDays(dtmStart As Date, dtmEnd As Date) As Integer
'Calculates the number of working days between two dates
'dtmStart - the first day to include in the range
'dtmEnd - the last day to include in the range
'Returns the number of working days between the two dates
'Both dates are counted if they are working days
Dim intTotalDays As Integer ' Counter for number of days
Dim dtmToday As Date ' To increment the date to compare
intTotalDays = DateDiff("d", dtmStart, dtmEnd) + 1 'Start with total days
'Add one to include
First Day
dtmToday = dtmStart 'Initiate compare date
Do Until dtmToday > dtmEnd
If Weekday(dtmToday, vbMonday) > 5 Then 'It is Saturday or
Sunday
intTotalDays = intTotalDays - 1 'Take one day away
for Weekend day
ElseIf Not IsNull(DLookup("[Holdate]", "Holidays", _
"[Holdate] = #" & dtmToday & "#")) Then 'It is a holiday
intTotalDays = intTotalDays - 1 'Take one day away
for the Holiday
End If
dtmToday = DateAdd("d", 1, dtmToday) 'Add a day for next
compare
Loop 'Until dtmToday > dtmEnd All days have been
compared
CalcWorkDays = intTotalDays 'Return the value
End Function
Qaspec said:
I'd like to find a case's end date when users enter information into the form.
Text Box names denoted within [].
For Example
[SD]Start Date = 4/1/06 (Cases start date)
[EH]Estimated Hours = 200 (Hours to complete case)
[PC]% Complete = 25 (How much of the case is already finished)
[PA]Allocation % = 20 (Personal percent of each day dedicated)
[RE]Resources = 4 (How many other people working on case)
[RA]Res Allocation % = 20 (resource's percent of each day dedicated)
Considering only workdays and that the standard workday is 8 hours long the
[EE]Estimated End Date should calculate to 4/27/06.
Thank you for your help.