Simple way to find max level 1 WBS and put all Level 2 WBS into array?

Question

I can't seem to find anything about how I might do this from the documentation. My question basically has it all. I need the max WBS level 1 value as an integer, and then to loop through all its level2 subtasks/summaries and put a couple of their values into an array.

It would also be handy if I could get number of subtasks that belong to that summary before iterating so I could dim my array with the correct rows/columns and not have to transpose it after-the-fact.

Any help or guidance would be appreciated, MS Project documentation is awful and the internet doesn't have much else on a lot of this.

I Don't want to have to do this:

Dim TopVal As Integer
For Each t in ActiveProject.Tasks
   Dim tVal As Integer
   tVal = t.WBS.Split("."c)(0)
   If  tVal > TopVal Then TopVal = tVal
Next t

Answer 1

Unfortunately, you will have to loop to figure things out. MS Project doesn't allow you to pull in a set of fields (like all the WBSs) into an array without looping through everything. For this problem, you'll need to determine two different bits of information: what level WBS you're working with and how many levels of sub-tasks are underneath that given WBS.

At the main program level, you'll need to run through ALL the tasks and determine the WBS level of each task. Once you get the level you want, then you can determine the number of sub-tasks.

Private Sub test()
    With ThisProject
        Dim i As Long
        For i = 1 To .Tasks.count
            Dim subWBSCount As Long
            If .Tasks.Item(i).OutlineLevel = 2 Then
                subWBSCount = GetSubWBSCount(.Tasks.Item(i).wbs, i)
                Debug.Print "At level 2 (" & .Tasks.Item(i).wbs & _
                            ") there are " & subWBSCount & " sub tasks"
                '-----------------------------------------------
                '    you can properly dimension your array here,
                '    then fill it with the sub-task information
                '    as needed
                '-----------------------------------------------
            End If
        Next i
    End With
End Sub

When you need to count the sub-tasks under the level 2 WBS, it's easiest to break into a separate function to keep the logic straight. What it does it to start with the given task and work down, comparing each subsequent task's WBS "prefix" -- meaning if you're looking for sub-tasks under WBS 1.1, then when you see WBS 1.1.1 and 1.1.2, you need to really compare the "1.1" parts of each of them. Count until you run out of sub-tasks.

Private Function GetSubWBSCount(ByVal topWBS As String, ByVal wbsIndex As Long) As Long
    '--- loop to find the given WBS, then determine how many
    '    sub tasks lie under that WBS
    With ThisProject
        Dim j As Long
        Dim count As Long
        For j = (wbsIndex + 1) To .Tasks.count
            Dim lastDotPos As Long
            lastDotPos = InStrRev(.Tasks.Item(j).wbs, _
                                  ".", , vbTextCompare)
            Dim wbsPrefix As String
            wbsPrefix = Left$(.Tasks.Item(j).wbs, _
                              lastDotPos - 1)
            If wbsPrefix = topWBS Then
                count = count + 1
                '--- check for the edge case where this is
                '    the very last task, and so our count is
                '    finished
                If j = .Tasks.count Then
                    GetSubWBSCount = count
                    Exit Function
                End If
            Else
                '--- once we run out of sub-wbs tasks that
                '    match, we're done
                GetSubWBSCount = count
                Exit Function
            End If
        Next j
    End With
End Function

Here's the whole test module:

Option Explicit

Private Sub test()
    With ThisProject
        Dim i As Long
        For i = 1 To .Tasks.count
            Dim subWBSCount As Long
            If .Tasks.Item(i).OutlineLevel = 2 Then
                subWBSCount = GetSubWBSCount(.Tasks.Item(i).wbs, i)
                Debug.Print "At level 2 (" & .Tasks.Item(i).wbs & _
                            ") there are " & subWBSCount & " sub tasks"
                '-----------------------------------------------
                '    you can properly dimension your array here,
                '    then fill it with the sub-task information
                '    as needed
                '-----------------------------------------------
            End If
        Next i
    End With
End Sub

Private Function GetSubWBSCount(ByVal topWBS As String, ByVal wbsIndex As Long) As Long
    '--- loop to find the given WBS, then determine how many
    '    sub tasks lie under that WBS
    With ThisProject
        Dim j As Long
        Dim count As Long
        For j = (wbsIndex + 1) To .Tasks.count
            Dim lastDotPos As Long
            lastDotPos = InStrRev(.Tasks.Item(j).wbs, _
                                  ".", , vbTextCompare)
            Dim wbsPrefix As String
            wbsPrefix = Left$(.Tasks.Item(j).wbs, _
                              lastDotPos - 1)
            If wbsPrefix = topWBS Then
                count = count + 1
                '--- check for the edge case where this is
                '    the very last task, and so our count is
                '    finished
                If j = .Tasks.count Then
                    GetSubWBSCount = count
                    Exit Function
                End If
            Else
                '--- once we run out of sub-wbs tasks that
                '    match, we're done
                GetSubWBSCount = count
                Exit Function
            End If
        Next j
    End With
End Function