PPC Part III: This Time...It's Personal

OK this is what happens when you write macros in the middle of the night. I found a few things wrong with the previous versions of the macro. It seems that it would count any complete task whose Baseline Finish date was before the Status date as a delivered promise. OOPS! :-)

 

I fixed this last night. But there are two versions. One that counts a task as a delivered promise if it's Baseline Finish is prior to the Status date AND it finished exactly on time (Actual Finish = Baseline Finish) and another version that counts a task as a delivered promise if the Baseline Finish is prior to theStatus Date AND it also finished prior to the Status Date even if that means it slipped past it's Baseline Finish.

Please give me some feedback on which one makes sense for you.

Thanks

 

Sub PPC_Basline_Dependant()
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 And (T.ActualFinish = T.BaselineFinish Or _
            T.ActualFinish < T.BaselineFinish) 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

Sub PPC_Status_Dependant()
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 And (T.ActualFinish = P.StatusDate Or _
            T.ActualFinish < P.StatusDate) 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