Work Breakdown Structure Numbering in Excel

I’ve never heard of Work Breakdown Structure (WBS) before, but I’ve definitely seen it. It’s that type of numbering I see in lawerly type documents. It looks like this:

Jeremy has seen it before and wrote an Excel macro to number an Excel list based on indentation.


It seemed to work well for me. Well, I didn’t read the instructions first which put me in an infinite loop. But once I broke out of that, read the instructions, and reformatted my data, it worked. In that regard, I’d add a If r > Rows.Count Then Exit Do in there just for good measure. Of course, I would use class modules to do this, but then Mike Alexander would just make fun of me for it. :)

Posted in Uncategorized

21 thoughts on “Work Breakdown Structure Numbering in Excel

  1. Dick,

    If you have never heard of WBS, it can only mean that you don’t plan your projects!

  2. Nested subsection numbers can be done with formulas. It helps to define an array referring to a sequence of integers from 1 to something reasonable, in this case 32 should be sufficient. So something like the name nums referring to the constant array {1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21;22;23;24;25;26;27;28;29;30;31;32}.

    If the topmost entry were in cell B2 and had no indentation, enter 1 in cell A2. For subsequent entries in column B, the column A formulas would be like so (here the formula for cell A3).

    =CHOOSE(2+SIGN(FIND(LEFT(TRIM(B2),1),B2)-FIND(LEFT(TRIM(B3),1),B3)),A2&”.1?,
    LEFT(A2,LOOKUP(2,1/(MID(“.”&A2,nums,1)=”.”),nums)-1)
    &(MID(A2,LOOKUP(2,1/(MID(“.”&A2,nums,1)=”.”),nums),3)+1),
    LEFT(LOOKUP(2,1/(FIND(LEFT(TRIM(B$2:B2),1),B$2:B2)
    =FIND(LEFT(TRIM(B3),1),B3)),A$2:A2),
    LOOKUP(2,1/(MID(“.”&LOOKUP(2,1/(FIND(LEFT(TRIM(B$2:B2),1),B$2:B2)
    =FIND(LEFT(TRIM(B3),1),B3)),A$2:A2),nums,1)=”.”),nums)-1)
    &(MID(LOOKUP(2,1/(FIND(LEFT(TRIM(B$2:B2),1),B$2:B2)
    =FIND(LEFT(TRIM(B3),1),B3)),A$2:A2),
    LOOKUP(2,1/(MID(“.”&LOOKUP(2,1/(FIND(LEFT(TRIM(B$2:B2),1),B$2:B2)
    =FIND(LEFT(TRIM(B3),1),B3)),A$2:A2),nums,1)=”.”),nums),3)+1))

    Rather long. If you’re willing to use a few more defined names involving partially or fully relative range addresses, you could define the following names with cell A3 the active cell.

    type: =2+SIGN(FIND(LEFT(TRIM(B2),1),B2)-FIND(LEFT(TRIM(B3),1),B3))

    base: =LOOKUP(2,1/(MID(“.”&A2,nums,1)=”.”),nums)

    prev: =LOOKUP(2,1/(FIND(LEFT(TRIM(B$2:B2),1),B$2:B2)=FIND(LEFT(TRIM(B3),1),B3)),A$2:A2)

    base.prev: =LOOKUP(2,1/(MID(“.”&prev,nums,1)=”.”),nums)

    Then the cell A3 formula reduces to

    =CHOOSE(type,A2&”.1?,LEFT(A2,base-1)&(MID(A2,base,3)+1),LEFT(prev,base.prev-1)&(MID(prev,base.prev,3)+1))

  3. Too bad no twisty snippet on the number 1. This would allow users to hide/show rows that had 1.1 througn 1.9.

  4. I wrote something similar for automatically indenting rows; that is, using the Outline feature of Excel. I work with a lot of Bill of Materials files, and many of these are multi-level explosions. Management likes indented files so that they can collapse and expand rows at will. I wrote this macro to take advantage of a “Level” column and a given data table.

    This code is extremely fast, even with 30,000+ rows of data. I haven’t updated this code in a while, it hasn’t been rigorously tested, and it only works on the ActiveSheet, but it could be easily modified to meet people’s needs (I will eventually do that myself). Hopefully, it will do someone some good.

    ”””””””””””””””””””””””””””””””””
    ‘ Comments:     This subroutine groups a spreadsheet into the
    ‘               same structure as the CAD tree.

    ‘ Arguments:    lLevelCol           The column containing level info
    ‘               lStartRow           The first row of data within the data table

    ‘ Date          Developer           Action
    ‘ —————————————————————-
    ‘ 01 Jul 06     Matthew Pfluger     Initial version
    ‘ 17 Jan 07     Matthew Pfluger     Corrected bugs with textual levels,
    ‘                                     program stopping before end
    ‘ 10 Apr 08     Matthew Pfluger     Added function to convert asterisks in the Level
    ‘                                     column to numeric value based on length
    ‘ 15 Apr 08     Matthew Pfluger     Code commenting and renaming of variables
    ‘ 29 Apr 08     Matthew Pfluger     Changed logic that warns of exceeding Excel’s max outline levels
    ‘ 08 May 08     Matthew Pfluger     Corrected bug when grouping to second-to-last row
    ‘ 05 Mar 09     Matthew Pfluger     Changed code so that lNumOfRows counts used rows in iLevelCol, not always column 1

    Public Function bApplyOutlining(ByVal lLevelCol As Integer, ByVal lStartRow As Long)

        ‘ Error handling
       Const sSOURCE As String = “bApplyOutlining”
        Dim bReturn As Boolean                            ‘ the function return value
       bReturn = True                                    ‘ assume success
       On Error GoTo ErrorHandler

        ‘ Reset existing outlining
       RemoveOutlining

        Dim bGroupFlag As Boolean                         ‘ a Boolean flag signaling that a gathering has been detected and will be grouped
       Dim lCount As Long                                ‘ temp integer variable for counting and looping
       Dim iCurLevel As Integer                          ‘ Current level; used to convert text to number
       Dim iStartLevel As Integer                        ‘ Start level; used to convert text to number
       Dim iMaxLevel As Integer                          ‘ the maximum value in the Level column
       Dim lCurrentRow As Long                           ‘ the row number of the current row
       Dim lGroupLevelThreshold As Long                  ‘ the minimum level a row must have in order to be grouped (Excel can only group 8 levels deep); not hardcoded to 8 so that one could group from 15 – 20 for example
       Dim lNumOfRows As Long                            ‘ the row number of the last row in the active sheet
       Dim rngLevelInfo As Range                         ‘ the range of level information
       Dim rng As Range                                  ‘ temp range variable

        ‘ Initialize Variables
       bGroupFlag = False
        lNumOfRows = Cells(Application.Rows.Count, lLevelCol).End(xlUp).Row
        Set rngLevelInfo = Range(Cells(lStartRow, lLevelCol), Cells(lNumOfRows, lLevelCol))

        ‘ Find max level and define minimum level in order to be grouped
       iMaxLevel = Application.WorksheetFunction.Max(rngLevelInfo)
        lGroupLevelThreshold = iMaxLevel – 7              ‘ Only highest eight levels will be grouped (Excel 2003 limits to 8 levels only)

        ‘ Change outline settings
       With ActiveSheet.Outline
            .SummaryRow = xlAbove
        End With

        ‘ Process rows until the first blank line
       Do Until (lStartRow >= lNumOfRows)
            lCurrentRow = lStartRow + 1

            ‘ Coerce level value to integer
           iStartLevel = CInt(Cells(lStartRow, lLevelCol).Value)

            If (iStartLevel >= lGroupLevelThreshold) Then    ‘ If row’s level doesn’t exceed lGroupLevelThreshold
               ‘ until current row’s level exceeds or is equal to starting row’s
               iCurLevel = CInt(Cells(lCurrentRow, lLevelCol).Value)

                ‘ Find the end of current group
               Do Until (iStartLevel >= iCurLevel Or lCurrentRow > lNumOfRows)
                    lCurrentRow = lCurrentRow + 1         ‘ If a group is found, set flag to true
                   bGroupFlag = True

                    ‘ Get level of current row
                   iCurLevel = CInt(Cells(lCurrentRow, lLevelCol).Value)
                Loop

                ‘ If a group is found
               If (bGroupFlag) Then
                    ‘ Group all rows under lStartRow to current row
                   Rows(lStartRow + 1 & “:” & lCurrentRow – 1).Group

                    ‘ Reset flag
                   bGroupFlag = False
                End If
            End If

            lStartRow = lStartRow + 1
        Loop

        Range(“a1”).Select

        ‘ Notify user if some levels were not grouped
       iStartLevel = Application.WorksheetFunction.Min(rngLevelInfo)
        If iMaxLevel – iStartLevel + 1 > 8 Then
            Call MsgBox(“There were too many sublevels in “ & ActiveSheet.Name & ” to group completely. “ & _
                        “Since Excel currently allows only 8 grouping levels, the level(s) 0 – “ & lGroupLevelThreshold – 1 & ” were not grouped.”)
        End If

    ErrorExit:

        ‘ Return result
       bApplyOutlining = bReturn

        Exit Function

    ErrorHandler:
        ‘ An error is reached if level information cannot be interpreted.  In such case,
       ‘ the macro removes outlining and notifies the user.
       MsgBox (“An unexpected error occured.  It is likely that your “ & _
                “level column contained text rather than only numbers.  “ & _
                “The data will be restored to its original form.”)

        Call RemoveOutlining

        ‘ Set return value to False to tell caller something went wrong
       bReturn = False
        Resume ErrorExit

    End Function

    ”””””””””””””””””””””””””””””””””
    ‘ Comments:     This procedure removes all tree formatting from the
    ‘               bApplyOutlining macro.

    ‘ Date          Developer           Action
    ‘ ————————————————————–
    ‘ 05 Sep 07     Matthew Pfluger     Initial version
    ‘ 14 Apr 08     Matthew Pfluger     Moved “reset last cell” to separate function
    ‘                                   Changed name

    Public Sub RemoveOutlining()
        On Error Resume Next

        ‘ Format all cells
       With Cells
            .Rows.OutlineLevel = 1                        ‘ Remove row outlining
           .Columns.OutlineLevel = 1                     ‘ Remove column outlining
           .EntireRow.Hidden = False                     ‘ Unhide all rows
           .EntireColumn.Hidden = False                  ‘ Unhide all columns
       End With

        ResetLastCell

    End Sub

    My apologies in advance if the code doesn’t copy correctly. Thanks to all MVPs out there for all your help in the past.

    Matthew Pfluger

  5. Just a point of clarification… A WBS is not the numbering system itself. WBS is a project management system designed to capture 100% of the project scope by defining milestones as nouns(deliverables) with specific costs, not verbs(tasks/actions). And then, there is a terribly long list of WBS do’s and dont’s. The genesis of the system was in the 50’s and it is now required for virtually all military projects.

    The WBS “rules” can be found here: http://www.acq.osd.mil/pm/currentpolicy/wbs/MIL_HDBK-881A/MILHDBK881A/WebHelp3/MILHDBK881A.htm

    and Wikipedia has a decent description: http://en.wikipedia.org/wiki/Work_breakdown_structure

  6. Hi Matthew,

    The code looks amazing and is just what I was searching for.
    The only problem I have is when i paste it to my excel VBA editor it comes with a lot of “Pasting Problems” It shows syntax errors.

    I would like to ask you pleas if you can send me an excel file with the code inside working already. My e-mail is: catuso.shz@gmail.com

    I will appreciate a lot all your help.

    Best regards,
    Sergio.

  7. Hi Matthew,

    Thank you very much for sharing your WBS outlining code (I’m sure this is especially appreciated by those of us who are relatively new to VBA)! I know this is an old thread and perhaps you wont know about comments made today, but I thought it worth a try.

    I too had problems pasting this into a standard code module. It seems that there are extra characters in the paste above (i.e. “>” in the first Do Loop “Do Until (lStartRow >= lNumOfRows)” & “&amp” in the MsgBox calls). I don’t see “gt” or “amp” as declared variables, so I am assuming these are simply pasting errors. And when I remove these characters in the editor, the code will compile. However, as documented in your developers comments, you moved function “ResetLastCell” to make it a separate function called by function RemoveOutlining (shown at the bottom of the pasted code above). Would you be so kind as to please provide the function “ResetLastCell” too. Of course, this would be greatly appreciated.

    If my assumption about removing characters “>” & “amp” above was incorrect, it would be nice if you could post (or email me, if you prefer) an example workbook with this code working. Having a working WBS outline in Excel would make my work life a lot easier and would give me another useful VBA example to study and learn from.

    Take care and best of everything,
    Mike
    jaden123451@hotmail.com

  8. Sergio: I switched to a better code rendering plugin for comments, but Matthew’s comments was before the switch. I just cleaned up the escape characters in his comment so you should be able to copy and paste it successfully now. Sorry for the inconvenience.

  9. Since I made that post last year, I’ve modified the code to make it faster and more robust. I’ve created an example workbook that contains all the outlining VBA code. I also included buttons and comments to help you debug the code and help learn how to use it and how it works. If anyone would like a copy, please email me at pflugs30{@] gmail (dot] com.

    I use this code nearly 10 times a day to outline Bill of Materials data, and several of these workbooks contain thousands of rows. This outlining code is fast, robust, and well tested in both Excel 2003 and 2007. I hope it helps you, too. Have a great day!

  10. Update: I’ve had a lot of interest in this code, and I’m glad it’s helping folks out. I would like to clarify that the code doesn’t look at the WBS code to do the outlining; rather, it requires a numeric level value to group on. That is, “1? has a level of 0, but “1.2.1.4? has a level of 4. You can calculate the Level from a WBS that uses a period (.) as its delimiter by using the following Excel formula:

    =LEN(B1)-LEN(SUBSTITUTE(B1,”.”,””))

  11. Being lazy, I do most ad hoc stuff from the immediate window and tweak it as needed.
    This means just entering commands without setting up any code modules.

    Suppose you’ve got a list of outline or indentation levels, as Matthew described.
    For the posted example this would be 0,1,2,2,1,2,2,2,0 down a column.

    To create the outline, you could select the range and enter from the VBE:

    Cells.ClearOutline: ActiveSheet.Outline.SummaryRow = xlabove: _
    For each c in selection:For i=1 to c:c.entirerow.group:Next i:Next c

    If it needs to run faster you could try (with 8 = maximum outline level):

    For i=1 to 8: selection.columndifferences(activecell).select: _
    For each a in selection.areas:a.entirerow.group:Next a:Next i

    Another useful thing is to link cells to parent rows. With the first column selected, try:

    for each c in selection.columndifferences(activecell): c.formula= _
    “=Hyperlink(“”#A””&row(” & selection.find(c-1,c,xlvalues,,,xlprevious).entirerow.address & “),” & c & “)”: next c

    Now you can trace dependencies with ctrl+[ and ] or Ctrl+Shift+{ and }

  12. The hyperlinks is a neat idea. If you’re going to do that, I would not use a FIND function, though. That has the tendency to be very slow, especially for large datasets. I would instead give each row a unique integer ID value and then create a “ParentID” column to store the ID value of the row’s parent. Then, you can replace the FIND function with an index function like INDEX or OFFSET which will calculate much faster and scale quite nicely.

  13. I am a newbie to building functions and macros for Excel, and for that matter VB. Could you please give me an example of the parameter values for (ByVal lLevelCol As Integer, ByVal lStartRow As Long)? I am a bit confused. For the example above, would lLvelCol be 1 and lStartRow be 2? When I attempt to run this I am getting some really strange values.

  14. Thanks for the info sharing Matt.

    The WBS to Outline Level formula is really what I was searching for!

    =LEN(B1)-LEN(SUBSTITUTE(B1,”.”,””))

    I use Excel and M Project all day long and every shortcut helps especially when trying to communicate between companies that use different PM software.

    Cheers!

  15. If indentation in column B is defiend by spaces, this code suffices:

    Sub M_snb()
    sn = Split(Replace(Space(20), " ", "0 "))
    n = 0

    sp = Cells(1).CurrentRegion

    For j = 2 To UBound(sp)
    y = Len(sp(j, 2)) - Len(Trim(sp(j, 2)))
    If y = 0 Then
    sq = sn
    sq(0) = n
    End If
    sq(y) = sq(y) + 1
    n = sq(0)
    For jj = 0 To y
    sp(j, 1) = sp(j, 1) & sq(jj) & "."
    Next
    Next

    Cells(1).CurrentRegion = sp
    End Sub

  16. Hey, thanks very much for this code. Its definitely something that people need, as my searches have shown.

    It works very well, and without too much fuss. Its a neat way of using the tab mechanism.

    Thanks again


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.