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. :)
I had a go at something similar: a generic tree-walker that could do different actions. The particular case was creating a directory tree corresponding to the indented list. However, you could easily generate nested numbering. I used an instance of a linked List class to hold the path.
See here: http://roymacleanvba.wordpress.com/2009/02/06/creating-a-directory-structure/
Friends don’t let friends abuse Class Modules.
Dick,
If you have never heard of WBS, it can only mean that you don’t plan your projects!
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))
Too bad no twisty snippet on the number 1. This would allow users to hide/show rows that had 1.1 througn 1.9.
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
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
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.
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)” & “&” 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
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.
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!
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,”.”,””))
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 }
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.
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.
@mlewis, send me an email at p|f|l|u|g|s|3|0@gmail.com, and I’ll send you an example file with full source code.
Matthew
Here is a good work breakdown structure example, not in excel but in a visual representation. The key is to breakdown the work/project into manageable activities and tasks. http://ygraph.com/chart/1430
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!
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
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