PPC Macro

Here is a first pass at the Percent of Promises Complete macro I talked about. It looks a little funny because of the way my blog is formatted but it pastes into the VBA window directly from the browser. If you have problems let me know via email (brian.kennemer@gmail.com) and I will send it to you in a text file. 

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

'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