Microsoft KB Archive/137744

= PRJ: Macro to Identify a Task's Driving Resources =

Article ID: 137744

Article Last Modified on 1/19/2007

-

APPLIES TO


 * Microsoft Project 98 Standard Edition
 * Microsoft Project 4.0 Standard Edition
 * Microsoft Project 4.1 Standard Edition
 * Microsoft Project 4.0 for Macintosh

-



This article was previously published under Q137744



SUMMARY
Microsoft Project does not have a built-in mechanism to identify a task's driving resources. This article provides a sample macro that identifies driving resources fro the selected task.



MORE INFORMATION
Microsoft provides examples of Visual Basic for applications procedures for illustration only, without warranty either expressed or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. This Visual Basic procedure is provided 'as is' and Microsoft does not guarantee that it can be used in all situations. Microsoft does not support modifications of this procedure to suit customer requirements for a particular purpose. Sub DrivingResource

'If no resources, end macro If ActiveCell.Task.Assignments.Count = 0 Then

MsgBox "Task" & ActiveCell.Task.ID & _ " has no resources assigned to it." End

End If

'Find largest work/units. For Each RA In ActiveCell.Task.Assignments

If (RA.Work / 60) / RA.Units > LgWrkUnits Then LgWrkUnits = (RA.Work / 60) / RA.Units End If

Next

'Different messages for fixed duration versus resource driven tasks. If ActiveCell.Task.FixedDuration Then

temp = "Task " & ActiveCell.Task.ID & _ " is Fixed Duration. If the task duration type is changed to" _ & " Resource Driven, the task will have a duration of " _ & Format(LgWrkUnits, "0.00") & _ "h and be driven by the following resources:" & Chr(13)

Else

temp = "Task " & ActiveCell.Task.ID _ & " has a duration of " & Format(LgWrkUnits, "0.00") & _ "h and is driven by the following resources:" & Chr(13)

End If

'Find which resource assignments share the largest work/units. For Each RA In ActiveCell.Task.Assignments

If (RA.Work / 60) / RA.Units = LgWrkUnits Then temp = temp & Chr(13) & "ID: " & RA.ResourceID & _ " Name: " & RA.ResourceName End If

Next MsgBox temp End Sub

