PPC Update

OK Bonehead move on my part. The macro I had posted for PPC had a flaw in it where if you ran it against a project with no tasks in it you got an OVERFLOW error. Sure, it will not be common for you to run this against an empty project but I should have trapped that and allowed for it.

It would also give you this OVERFLOW error if the Status Date was set to fall after ALL of the Baseline Finish dates in the project (so that there were NO promised tasks).

The new version below will check for empty projects before it runs and warn you about this. It also checks to see if the number of promised  tasks is 0 and then notifies you if this is the case and stops the calculation.

(Again, the macro will look odd below because of formatting but it should paste into your VBA window nicely. Let me know if you have trouble and I will send it to you in an email.)

Sub PPC()
Dim P As Project
Dim T As Task
Dim Promised As Integer
Dim Delivered As Integer
Dim PPC As Long
Set P = Application.ActiveProject

'Check to see if there is a status date
If P.StatusDate = "NA" Then
    MsgBox Prompt:="There is no status date for the project" & Chr(13) _
    & "You must save a Status Date to calculate PPC"
End If

'Loop through all tasks
For Each T In P.Tasks
    If Not (T Is Nothing) Then
       
        'Check to see if the task has a baseline saved. If it does not then
        'stop the macro.
        If T.BaselineFinish = "NA" Then
            MsgBox Prompt:="Task ID " & T.ID & " does not have a baseline saved" _
            & Chr(13) & "You must save a baseline for all tasks to calculate PPC"
            End
        End If
       
        'Check to see if the baseline finish is less than or equal to the status date
        'If it is then increment Promised
        If T.BaselineFinish = P.StatusDate Or T.BaselineFinish < P.StatusDate Then
            Promised = Promised + 1
           
            'Check to see if the promised task is complete.
            'If it is then increment Delivered
            If T.PercentComplete = 100 Then
                Delivered = Delivered + 1
            End If
        End If
    End If
Next T

If Promised = 0 Then
    MsgBox Prompt:="You have no tasks in the project that have been promised prior to the current Status Date"
    End
End If

'Calculate PPC
PPC = (Delivered / Promised) * 100

'Loop back through and set Text 20 to be equal to PPC
For Each T In ActiveProject.Tasks
    If Not (T Is Nothing) Then
        T.Text20 = PPC & "%"
    End If
Next T
End Sub