MS Project 2013: display resources on summary task

Question

Is there a way to configure MS Project 2013 so that it displays in a resource column (eg, resource initials) of the Gantt Chart view of summary tasks the UNION of all resources assigned to its leaf subtasks.

Say for example that I have a summary task S with 2 subtasks S1 & S2, S2 being itself divided into subsubtasks S21 & S22.

Say also that I have allocated resources R1,R2 to S1, resources R2,R3 to S21 and resource R4 to S22.

With my current configuration, the resource initial column of both S2 and S are left blank.

Instead, I would like the resource column of S2 to display R2, R3, R4 and the resource column of S to display R1, R2, R3, R4.

The idea is to be able to visualize all the resources allocated to a summary tasks even when its decomposition in subtasks is hidden.

Thank you very in advance for suggestions on how to achieve this.

Answer 1

Those resource fields exist at the summary level because you can directly assign resources to a summary task, so you can't use those fields for this purpose. However, here's a macro that aggregates the names of the resources assigned to the subtasks. The results are put in Text1 at the summary level. You can then modify the Gantt chart bar styles to show that text field.

Sub RollupResourceNames()

    Dim tsk As Task
    Dim list As String
    Dim key As Variant

    For Each tsk In ActiveProject.Tasks
        If tsk.Summary Then
            Dim col As New Collection
            Set col = GetChildResourceAssignments(tsk)
            list = vbNullString
            For Each key In col
                list = list & ", " & key
            Next
            If Len(list) > 2 Then
                list = Mid$(list, 3)
            End If
            tsk.Text1 = list
        End If
    Next tsk

End Sub

Function GetChildResourceAssignments(parent As Task) As Collection

    Dim col As New Collection

    Dim child As Task
    Dim asn As Assignment
    For Each child In parent.OutlineChildren
        If child.Summary Then
            Dim col2 As New Collection
            Set col2 = GetChildResourceAssignments(child)
            Dim key As Variant
            For Each key In col2
                col.Add key, key
            Next key
        End If
        For Each asn In child.Assignments
            On Error Resume Next
            col.Add asn.Resource.Name, asn.Resource.Name
            On Error GoTo 0
        Next asn
    Next child

    Set GetChildResourceAssignments = col

End Function

Answer 2

@Rachel Hettinger - Solution works great, except it will error out (error 457) if you have multiple levels of parent/child tasks and the same resource is present across different levels. It tries to add the resource name to the collection, but it already exists (since it was added earlier when the script checked the other set of tasks) and doesn't know what to do.

This is fixable by simply adding another "On Error Resume Next" line. Here is the revised macro, which works perfectly on my Project Plan. All credit to Rachel Hettinger here, I just added one line!

Sub RollupResourceNames()

    Dim tsk As Task
    Dim list As String
    Dim key As Variant

    For Each tsk In ActiveProject.Tasks
        If tsk.Summary Then
            Dim col As New Collection
            Set col = GetChildResourceAssignments(tsk)
            list = vbNullString
            For Each key In col
                list = list & ", " & key
            Next
            If Len(list) > 2 Then
                list = Mid$(list, 3)
            End If
            tsk.Text1 = list
        End If
    Next tsk

End Sub

Function GetChildResourceAssignments(parent As Task) As Collection

    Dim col As New Collection

    Dim child As Task
    Dim asn As Assignment
    For Each child In parent.OutlineChildren
        If child.Summary Then
            Dim col2 As New Collection
            Set col2 = GetChildResourceAssignments(child)
            Dim key As Variant
            For Each key In col2
                On Error Resume Next
                col.Add key, key
            Next key
        End If
        For Each asn In child.Assignments
            On Error Resume Next
            col.Add asn.Resource.Name, asn.Resource.Name
            On Error GoTo 0
        Next asn
    Next child

    Set GetChildResourceAssignments = col

End Function