Forum Discussion
VIsual Basic and MS Project
Here ya go. This is the macro:
Sub StatusMetrics()
'macro written for Riele485 by John-Project 2/4/2022
Dim t As Task, PS As Task
Dim Cnt As Single, Comp As Single, Lat As Single, OT As Single, Fut As Single
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
If t.Summary = False Then Cnt = Cnt + 1
If t.Status = pjComplete Then Comp = Comp + 1
If t.Status = pjLate Then Lat = Lat + 1
If t.Status = pjOnSchedule Then OT = OT + 1
If t.Status = pjFutureTask Then Fut = Fut + 1
End If
Next t
Set PS = ActiveProject.ProjectSummaryTask
PS.Text1 = Cnt
PS.Text2 = Format(Comp / Cnt * 100, "##.0") & " %"
PS.Text3 = Format(Lat / Cnt * 100, "##.0") & " %"
PS.Text4 = Format(OT / Cnt * 100, "##.0") & " %"
PS.Text5 = Format(Fut / Cnt * 100, "##.0") & " %"
MsgBox "Total tasks: " & PS.Text1 & vbCr _
& "Completed: " & PS.Text2 & vbCr _
& "Late: " & PS.Text3 & vbCr _
& "On Time: " & PS.Text4 & vbCr _
& "Future: " & PS.Text5, Title:="Status Metrics"
End SubAnd this is the result on a sample file:
Pretty sweet huh?
John
Here ya go. This is the macro:
Sub StatusMetrics()
'macro written for Riele485 by John-Project 2/4/2022
Dim t As Task, PS As Task
Dim Cnt As Single, Comp As Single, Lat As Single, OT As Single, Fut As Single
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
If t.Summary = False Then Cnt = Cnt + 1
If t.Status = pjComplete Then Comp = Comp + 1
If t.Status = pjLate Then Lat = Lat + 1
If t.Status = pjOnSchedule Then OT = OT + 1
If t.Status = pjFutureTask Then Fut = Fut + 1
End If
Next t
Set PS = ActiveProject.ProjectSummaryTask
PS.Text1 = Cnt
PS.Text2 = Format(Comp / Cnt * 100, "##.0") & " %"
PS.Text3 = Format(Lat / Cnt * 100, "##.0") & " %"
PS.Text4 = Format(OT / Cnt * 100, "##.0") & " %"
PS.Text5 = Format(Fut / Cnt * 100, "##.0") & " %"
MsgBox "Total tasks: " & PS.Text1 & vbCr _
& "Completed: " & PS.Text2 & vbCr _
& "Late: " & PS.Text3 & vbCr _
& "On Time: " & PS.Text4 & vbCr _
& "Future: " & PS.Text5, Title:="Status Metrics"
End Sub
And this is the result on a sample file:
Pretty sweet huh?
John
- Thaks, John!
Oops! I was so enamored with the awesome macro I wrote that I didn't do a simple check on the output. And after all that talk about not including summary lines, the original code did in fact count the status of summary lines. So, here is the revised macro code. Note, due to rounding percentages may not add up to exactly 100%.
Sub StatusMetrics()
'macro written for Riele485 by John-Project 2/4/2022
' fixed an issue that included summary lines in calculations 2/7/22
Dim t As Task, PS As Task
Dim Cnt As Single, Comp As Single, Lat As Single, OT As Single, Fut As Single
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
If t.Summary = False Then
Cnt = Cnt + 1
If t.Status = pjComplete Then Comp = Comp + 1
If t.Status = pjLate Then Lat = Lat + 1
If t.Status = pjOnSchedule Then OT = OT + 1
If t.Status = pjFutureTask Then Fut = Fut + 1
End If
End If
Next t
Set PS = ActiveProject.ProjectSummaryTask
PS.Text1 = Cnt
PS.Text2 = Format(Comp / Cnt * 100, "##.0") & " %"
PS.Text3 = Format(Lat / Cnt * 100, "##.0") & " %"
PS.Text4 = Format(OT / Cnt * 100, "##.0") & " %"
PS.Text5 = Format(Fut / Cnt * 100, "##.0") & " %"
MsgBox "Total tasks: " & PS.Text1 & vbCr _
& "Completed: " & PS.Text2 & vbCr _
& "Late: " & PS.Text3 & vbCr _
& "On Time: " & PS.Text4 & vbCr _
& "Future: " & PS.Text5, Title:="Status Metrics - Rev A"
End SubJohn
- Complementing,
PS.Text21 = Comp
PS.Text22 = Lat
PS.Text23 = OT
PS.Text24 = Fut
PS.Text14 = Cnt
PS.Text15 = Format(Comp / Cnt * 100, "##.0") & " %"
PS.Text16 = Format(Lat / Cnt * 100, "##.0") & " %"
PS.Text17 = Format(OT / Cnt * 100, "##.0") & " %"
PS.Text18 = Format(Fut / Cnt * 100, "##.0") & " %"
MsgBox "Total Tasks " & PS.Text14 & vbCr _
& "Completed: " & PS.Text15 & vbCr _
& "Delayed: " & PS.Text16 & vbCr _
& "On Deadline: " & PS.Text17 & vbCr _
& "Future Task: " & PS.Text18, Title:="Status Consolidation"
End Sub
The result was:
Text21=49
Text22=22
Text23=10
Text24=71
Total=152<> CNT=120
The problem is in CNT, I think! - ohn, allow me: shouldn't the percentages close to 100%? That is, 120 tasks with the percentages distributed adding up to 100%. See the picture, please!
- Understood! Thanks for your help! Was very good!
- Riele485,
Keep in mind that summary lines are NOT tasks so if you are adding them to the task count, your data is skewed.
John - For example, I added “overdue” status tasks and the percentage only closed when I added the summary tasks, and the same with the other statuses. But thanks for everything!
- Riele485,
You're welcome and thanks for the feedback.
I don't quite understand you comment about "counting summary status". I purposefully excluded displaying anything at each summary level. Your request was for an output message which is what the macro provides. Including the metrics at Project Summary Level was an added bonus such that the data is still available/visible once the user message is closed.
John Thank you, John! The answer came faster than I thought!
You are a skilled professional. Congratulations!
Just an observation, as you can see in the image, it is counting the summary status in percentage, as indicated by the arrows.
But, it was a great job you did!