• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro to group rows under parent row based on WBS Column

T

Tram357

New Member
Hey all, posting to give back a bit.

I needed a macro to enable the grouping of rows under a parent row based on the value of a Work Breakdown Structure column for a project toolkit I was creating. I searched online for help and found a thread on Chandoo that gave the foundation of the macro script that ended up working for me. I unfortunately can't remember or find the original thread that I got the foundation of this code from, but to whoever it was, I'm forever grateful.

I've done some editing of my own, as well as a bit of ChatGPT to help me clean up and make the code more concise, which I'm pasting below. I'll be honest, I probably can't help you at all in editing it to suit your needs.

The code functions in my sheet by: calculating the number of '.' in my Work Breakdown Structure column and then grouping rows under the parent rows above them in ascending order. (E.g, A row that had a value of 1.1.2 in the WBS cell would be grouped under 1.1, and 1.1 and 1.2 would be grouped under 1. 2.1, 2.2, 2.3 would be grouped under 2, etc.)

It allows up to 8 total levels of breakdown / granularity (1.1.1.1.1.1.1.1) which I feel like is more than enough for 99% of use cases. I have it linked to a button on my sheet for easy sorting/grouping and it works a charm. Hope you find some value in it!


Code: 
Sub BuildOutlineWithExclusion()
    Dim lastRow As Long
    Dim grpRow(1 To 8) As Long
    Dim i As Long, j As Long
    Dim curLVL As Long
    Dim WBSValue As String

    Application.ScreenUpdating = False
    With Worksheets("WORKSHEET NAME") ' Adjust sheet name as needed
        .Cells.EntireRow.ClearOutline ' Clear any existing grouping
        lastRow = .Cells(.Rows.Count, "COLUMN").End(xlUp).Row ' Find the last row in the WBS. Make sure to change COLUMN to the appropriate column letter

        ' Initialize grpRow array to the last row, hard capped at a total of 8 levels allowed. No editing required.
        For i = 1 To 8
            grpRow(i) = lastRow
        Next i

        ' Process rows in reverse order (bottom to top). No editing required.
        For i = lastRow To 12 Step -1 ' Start at the last row, stop at row 12. Change '12' to the top of your table you want grouped. Change last row to the bottom of the table, if there is one.
            WBSValue = Trim(.Cells(i, "COLUMN").Value) ' Get WBS value in column, trim spaces. Make sure to change COLUMN to the appropriate column letter

            ' Skip blank rows and phase/divider rows. No editing required.
            If WBSValue = "" Or WBSValue = "PHASE" Or WBSValue = "EXCLUDE" Then
                ' Reset the current grouping level for excluded rows. Enter EXCLUDE or PHASE to the WBS cell for any rows you don't want to be grouped.
                For j = 1 To 8
                    If grpRow(j) = i Then
                        grpRow(j) = i - 1
                    End If
                Next j
            Else
                curLVL = lvlCount(WBSValue) ' Get the WBS level of the current row. No editing required

                ' If moving up to a parent level, set the start of the group. No editing required.
                If curLVL < lvlCount(Trim(.Cells(i + 1, "E").Value)) Then
                    .Rows(i + 1 & ":" & grpRow(curLVL + 1)).EntireRow.Group ' Group all subtasks under the parent. No editing required.
                    ' Reset lower levels for the next parent. No editing required.
                    For j = curLVL + 1 To 8
                        grpRow(j) = i - 1
                    Next j
                ElseIf curLVL > lvlCount(Trim(.Cells(i + 1, "E").Value)) Then
                    grpRow(curLVL) = i ' Adjust grouping start for the current level. No editing required.
                End If
            End If
        Next i

        ' Ensure summary rows appear above the group. No editing required.
        .Outline.SummaryRow = xlAbove
    End With
    Application.ScreenUpdating = True
    MsgBox "WBS Groups refreshed successfully!", vbInformation
End Sub

Function lvlCount(WBS As String) As Integer
    ' Calculate the level of the WBS number based on the number of periods. No editing required.
    lvlCount = Len(WBS) - Len(Replace(WBS, ".", "")) + 1
End Function
 
Did You find ?

Macro/VBA for grouping/outline of WBS structure

I have searched high and low for this and I'm wondering if it's even possible now... but if I'm to find the answer, I believe this is the place! In exporting or copying/pasting a project plan from Project into Excel, I would like to add grouping of rows just as found in Project, where I can...
chandoo.org
 
You must log in or register to reply here.
Back
Top