Get TASK "OVERALLOCATED" (VBA) - Microsoft Project

Question

I need to get when TASK is overallocated (because one or more resources are overallocated). I am already able to get overallocated resources, but since for the app the resource (if overallocated) is ALWAYS overallocated, so I have to identify only when the resource for the specific TASK is overallocated.

I mean, The red-man in Indicators column is exactly what I want to get:

• the tasks #2 and 6# are "overallocated" ( because resource "MCA" is engaged for same day ) --> yes trigger for my alert
• the task #4 is not overallocated (no red man) --> no trigger (although MCA is globally overallocated)

So, how can I identify (using VBA) all the tasks with red man in indicators column?

Many thanks in advance R

Answer 1

The correct property would be Task.Overallocated except that it doesn't seem to work--the value is always False (or "No" when shown in the Gantt Chart view).

The work-around is to loop through the resources using the Resource.Overallocated property (which does work) and then loop through the assignments for over-allocated resources to find the tasks on the over-allocated days.

Note: It is important to get the collection of TimeScaleValues at the resource level to get the total assigned to that resource for each day (e.g. use Set tsvs = res.TimeScaleData... instead of Set tsvs = asn.TimeScaleData...).

Sub FindOverAllocatedTasks()

    Dim overAllocTasks As New Collection
    
    Dim res As Resource
    For Each res In ActiveProject.Resources
        If res.overAllocated Then
            
            Dim maxMinutes As Double
            maxMinutes = res.MaxUnits * 60 * ActiveProject.HoursPerDay
            
            Dim asn As Assignment
            For Each asn In res.Assignments
            
                Dim tsvs As TimeScaleValues
                Set tsvs = res.TimeScaleData(asn.Start, asn.Finish, pjResourceTimescaledWork, pjTimescaleDays)
                Dim tsv As TimeScaleValue
                For Each tsv In tsvs
                    If VarType(tsv.Value) = vbDouble Then
                        If tsv.Value > maxMinutes Then
                            If Not Contains(overAllocTasks, CStr(asn.Task.UniqueID)) Then
                                overAllocTasks.Add asn.Task, CStr(asn.Task.UniqueID)
                            End If
                        End If
                    End If
                Next tsv
            
            Next asn
            
        End If
    Next res

    MsgBox overAllocTasks.Count
    
End Sub

Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
    Contains = True
    obj = col(key)
    Exit Function
err:

    Contains = False
End Function