Quick and Dirty Schedule Auditing


Here is some starter code for doing quick checks of the tasks in a project. This code will create a ‘report’ that shows the tasks that have estimated durations, tasks that are not fixed work and tasks that do not have any resources assigned. It also collects the names of resources that are not assigned to any tasks.

It should be noted that there are real products out there like QuantumPMs Quantum Schedule Auditor that does this in a much more sophisticated way (you should check out that product if you need to do more systematic and regular auditing.)

But that said if you need to do quick checks here is some code that shows some sample checks and a way to put the results into the clipboard so you can paste it into Word or Excel.

It is possible to have all the report building stuff on one big line but I like to break this kind of thing out on several lines. It makes it easier to add new stuff into the middle of the report.

Sub ProjectChecker()
Dim t As Task
Dim r As Resource

Dim EstimatedDurCount As Integer
Dim EstimatedDurTask As String

Dim NotFixedWorkCount As Integer
Dim NotFixedWorkTask As String

Dim NoResourceAssignedCount As Integer
Dim NoResourceAssignedTask As String

Dim ResWithNoAssignCount As Integer
Dim ResWithNoAssignResource As String

Dim Report As String
Dim MyData As DataObject
Set MyData = New DataObject

For Each t In ActiveProject.Tasks
    If Not (t Is Nothing) Then
        If t.Estimated = True And t.Summary = False Then
            EstimatedDurCount = EstimatedDurCount + 1
            EstimatedDurTask = EstimatedDurTask + t.Name & Chr(13)
        End If
        If t.Type <> pjFixedWork And t.Summary = False Then
            NotFixedWorkCount = NotFixedWorkCount + 1
            NotFixedWorkTask = NotFixedWorkTask + t.Name & Chr(13)
        End If
        If t.Milestone = False And t.Summary = False And t.Resources.Count = 0 Then
            NoResourceAssignedCount = NoResourceAssignedCount + 1
            NoResourceAssignedTask = NoResourceAssignedTask + t.Name & Chr(13)
        End If
    End If
Next t

For Each r In ActiveProject.Resources
    If Not (r Is Nothing) Then
        If r.Assignments.Count = 0 Then
            ResWithNoAssignCount = ResWithNoAssignCount + 1
            ResWithNoAssignResource = ResWithNoAssignResource + r.Name + Chr(13)
        End If
    End If
Next r

'Building Report
Report = "Project Name: " & ActiveProject.Name & Chr(13) & Chr(13)
Report = Report & "**** Tasks Section ****" & Chr(13)
Report = Report & "Count of tasks with Estimated Durations: " & EstimatedDurCount & Chr(13)
Report = Report & EstimatedDurTask & Chr(13)
Report = Report & "Count of tasks that are NOT Fixed Work: " & NotFixedWorkCount & Chr(13)
Report = Report & NotFixedWorkTask & Chr(13)
Report = Report & "Count of tasks without a resource assignment: " & NoResourceAssignedCount & Chr(13)
Report = Report & NoResourceAssignedTask & Chr(13)
Report = Report & Chr(13) & "****Resource Section****" & Chr(13)
Report = Report & "Count Resources with No Assignments: " & ResWithNoAssignCount & Chr(13)
Report = Report & ResWithNoAssignResource & Chr(13)

MyData.SetText Text:=Report
MyData.PutInClipboard

End Sub


Skip to main content