Forum Discussion
VIsual Basic and MS Project
- Feb 04, 2022
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
Yes. If you can provide more specific details about exactly what you want, I'll be happy to help you.
John