VIsual Basic and MS Project

[Riele485]

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?

[#2]

Riele485,
Yes. If you can provide more specific details about exactly what you want, I'll be happy to help you.
John

[#3]

Without having to use Excel, develop macro in MS Project that informs me in the sets of tasks, percentage of each Task Status: completed, late, on time and future.

[#4]

Riele485,
Sorry but that's not much in the way of specifics.
1. Are you looking for a count of each type of status?
2. Where would you like to see the data (e.g. Project Summary Task)?
John

[#5]

Sorry but that's not much in the way of specifics.
1. Are you looking for a count of each type of status?

Tasks total, and total percentage of each status on tasks.
Yes. Task total and total percentage each status on task.
2. Where would you like to see the data (e.g. Project Summary Task)?
Can be!

[#6]

By example:
Total task: 100
Completed: 30%
Late: 20%
On time: 40%
Future: 10%

[#7]

Riele485,
Okay, that's something I can work with. Matter of fact, its nearly identical to something I did as added benefit to a much more complex macro I wrote for another user last year.

Stay tuned, I'll update this response with the macro a little later.
John

[#8]

Thanks! I will be waiting!

[#9 · Accepted solution]

@Riele485 

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

[#10]

@John-project 

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!

[#11]

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

[#12]

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!

[#13]

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

[#14]

Understood! Thanks for your help! Was very good!

[#15]

@Riele485 

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!

[#16]

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!

[#17]

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!

[#18]

@Riele485 

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

[#19]

Thaks, John!