Feb 04 2022 06:28 AM
Is it possible to develop in Visual Basic within the MS Project feature to report on a set of tasks a percentage of the status of tasks, for example, how many percent are completed, how much percent are late, etc?
Feb 04 2022 07:10 AM
Feb 04 2022 07:26 AM
Feb 04 2022 07:36 AM
Feb 04 2022 07:47 AM
Feb 04 2022 08:01 AM
Feb 04 2022 08:54 AM
Feb 04 2022 09:46 AM
SolutionHere 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
Feb 04 2022 06:00 PM
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!
Feb 05 2022 08:35 AM
Feb 05 2022 09:04 AM
Feb 05 2022 05:28 PM
Feb 05 2022 05:38 PM
Feb 07 2022 05:40 AM
John, allow me: shouldn't the percentages close to 100%? That is, 120 tasks with the percentages distributed adding up to 20%. See the picture, please!
Feb 07 2022 05:41 AM
Feb 07 2022 06:37 AM
Feb 07 2022 08:09 AM - edited Feb 07 2022 08:10 AM
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 Sub
John
Feb 04 2022 09:46 AM
SolutionHere 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