I doubt anyone will twitterbook about this on their InterScapes, but I know there’s a niche audience out there for this sort of Excel hackery so I’m posting it anyway.
If you know why you’re reading this already, skip to the code below the fold. Otherwise, here’s some explanation. In a project Work Breakdown Structure (WBS), tasks are organized into major tasks, sub-tasks, sub-sub-tasks, etc. as in the following example which is an actual project plan used by NASA:
1 Build a spaceship 1.1 Read wikipedia article on spaceships to determine required supplies 1.2 Buy spaceship supplies 1.3 Assemble spaceship 1.3.1 Attach top part to middle part 1.3.2 Attach middle part to thruster thingie 1.3.3 Paint spaceship a neat-o color 1.4 Set spaceship upright (facing sky) 2 Fly around in spaceship 3 Discover strange new worlds 4 Return home 4.1 Point spaceship at Earth 4.2 Land spaceship on Earth 4.3 Park spaceship in designated parking space
Instead of sequentially numbering the tasks, we assign subtask numbers to those tasks that roll up under other tasks. Assemble spaceship is a subtask of Build a spaceship so it gets Build a spaceship‘s number (1) plus a subtask number (3, since it’s the third subtask) so its WBS number is 1.3. Attach top part to middle part is a subtask of Assemble spaceship, so it gets 1.3 plus a sub-subtask number (1.3.1), and so on. MS Project also bolds any items with subtasks.
Since this type of WBS or outline numbering functionality isn’t available in Excel, it requires a VBA macro. Free code after the fold.
Update September 8: Here is a sample spreadsheet, complete with the code and a command button, for those who want something ready-to-use. Also, I am pleased to learn that this post was featured on the Daily Dose of Excel blog on June 10.
Update June 1: I discovered (and have added to the code) the most effective trick ever for speeding up Excel macros: Application.ScreenUpdating = False.
Update April 6: Added “format as text” line into the marco to prevent truncation of tasks ending in 0 (1.10, etc. — thanks Nick!) and fixed minor problem with parent-task formatting.
Notes about the macro:
- Tested in Excel 2003 and 2007 for Windows.
- The macro is based on the concept that the indentation of a particular task in column B dictates its WBS “depth” (whether it’s a task, sub-task, sub-sub-task, etc.). WBS numbering will be created in column A:
- Indenting and “outdenting” is done with this control in Excel
- The macro renumbers everything at once, so after you add this macro to your project’s VB code, create a button or other control that runs the macro.
- It requires certain formatting. Read all of the formatting assumptions, commented at the top of the macro.
VBA Code:
Sub WBSNumbering
'Renumber tasks on a project plan
'Associate this code with a button or other control on your spreadsheet
'Layout Assumptions:
'Row 1 contains column headings
'Column A contains WBS numbers
'Column B contains Task description, with appropriate indentation
'Some text (here we assume "END OF PROJECT") delimits the end of the task list
On Error Resume Next
'Hide page breaks and disable screen updating (speeds up processing)
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
'Format WBS column as text (so zeros are not truncated)
ActiveSheet.Range("A:A").NumberFormat = "@"
Dim r As Long 'Row counter
Dim depth As Long 'How many "decimal" places for each task
Dim wbsarray() As Long 'Master array holds counters for each WBS level
Dim basenum As Long 'Whole number sequencing variable
Dim wbs As String 'The WBS string for each task
Dim aloop As Long 'General purpose For/Next loop counter
r = 2 'Starting row
basenum = 0 'Initialize whole numbers
ReDim wbsarray(0 To 0) As Long 'Initialize WBS ennumeration array
'Loop through cells with project tasks and generate WBS
Do While Cells(r, 2) <> "END OF PROJECT"
'Ignore empty tasks in column B
If Cells(r, 2) <> "" Then
'Skip hidden rows
If Rows(r).EntireRow.Hidden = False Then
'Get indentation level of task in col B
depth = Cells(r, 2).IndentLevel
'Case if no depth (whole number master task)
If depth = 0 Then
'increment WBS base number
basenum = basenum + 1
wbs = CStr(basenum)
ReDim wbsarray(0 To 0)
'Case if task has WBS depth (is a subtask, sub-subtask, etc.)
Else
'Resize the WBS array according to current depth
ReDim Preserve wbsarray(0 To depth) As Long
'Repurpose depth to refer to array size; arrays start at 0
depth = depth - 1
'Case if this is the first subtask
If wbsarray(depth) <> 0 Then
wbsarray(depth) = wbsarray(depth) + 1
'Case if we are incrementing a subtask
Else
wbsarray(depth) = 1
End If
'Only ennumerate WBS as deep as the indentation calls for;
'so we clear previous stored values for deeper levels
If wbsarray(depth + 1) <> 0 Then
For aloop = depth + 1 To UBound(wbsarray)
wbsarray(aloop) = 0
Next aloop
End If
'Assign contents of array to WBS string
wbs = CStr(basenum)
For aloop = 0 To depth
wbs = wbs & "." & CStr(wbsarray(aloop))
Next aloop
End If
'Populate target cell with WBS number
Cells(r, 1).Value = wbs
'Get rid of annoying "number stored as text" error
Cells(r, 1).Errors(xlNumberAsText).Ignore = True
'Apply text format: next row is deeper than current
If Cells(r + 1, 2).IndentLevel > Cells(r, 2).IndentLevel Then
Cells(r, 1).Font.Bold = True
Cells(r, 2).Font.Bold = True
'Else (next row is same/shallower than current) no format
Else
Cells(r, 1).Font.Bold = False
Cells(r, 2).Font.Bold = False
End If
'Special formatting for master (whole number) tasks)
If Cells(r, 2).IndentLevel = 0 Then
Cells(r, 1).Font.Bold = True
Cells(r, 2).Font.Bold = True
'Add whatever other formatting you want here
End If
End If
End If
'Go to the next row
r = r + 1
Loop
End Sub
This is the personal website of Jeremy Modjeska.
Most code, content, and design, including custom WordPress theme
bartlet 1.0
are © 2009 by Jeremy.
License and copyright for all original material is at
Hi,
This macro works brilliantly except for one slight flaw with the numbering. When you get to ten sub items (or multiples of ten) e.g. 7.10, because of the way it is set up on numbers, it returns 7.1, thus duplicating the the first sub item (7.1).
Any ideas on how you stop the macro or excel doing this?
Hi Nick — I am amazed that someone found a use for this so quickly and I’m really glad it works for you. Thanks for the question; try formatting the WBS column as text and then re-running the numbering macro.
When I get a chance I’ll go back and add that action into the macro; I should have included it either as an assumption or in the code. As you might have seen, the macro already removes “Number Stored As Text” errors because it’s assuming that the column is in text format.
Update — I think I fixed this. Let me know if the new macro successfully eliminates this issue.
Thanks so much for this. It really helped out on a project at work.
Very nice code! The next phase, it seems to me, is to run through and set row groupings based on the WBS, so that the whole thing really does become a expandable/collapsable project plan.
I agree with Scott…any ideas on how to auto-group (outline)? I’ll do some googling and see if I can see if someone else has done something like this.
Thanks Scott & Brent. I think that’s a good suggestion. I was looking into how to do it and I think the easiest way is Group & Outline (http://office.microsoft.com/en-us/excel/HP052016411033.aspx) but it’s kind of ugly so, as usual, I’m going to see if I can find a more complicated solution. Pretty busy right now but this is on my to-do list. If one of you figures it out first, please let me know and I can post an update with your contribution.
This a great tool but not having a programming background are there any steps for me as a layman to take to program this onto my computer? May be a stupid question… not really sure.
Thanks
Hi Mark. Try this: http://j.modjeska.us/data/wbs_numbering.xlsm. I hope this helps.
Thank you very much for posting this, especially the xlsm download. Your contribution is going to be a key factor in the success of a project that I am working on.
Have you looked at an Earned Value Management supplement to this macro?
Thanks again
AWESOME!!! Thank you very much.
Great macro. One question left, i also don’t have any knowledge of programming. What do i need to delete or modify in the Macro, if i only want that level 1 items will be bold?
Cheers Chris, Martin, and Ellerd.
Chris – my long-term goal is to develop this into a much more comprehensive project management tool. Earned value management would definitely be a nice feature so I’ll add that to the list. Unfortunately life is getting in the way of my little programming projects these days and I probably won’t be making much progress on this for a while. Collapsible task groups are the next thing on the list.
Ellerd – first, unbold all your current lines on the project. Then comment out what appear above as lines 95-103 in the code above and re-run the macro. To comment out a line, just put a single quote mark at the beginning, like you see on line 94 (once commented it will turn green). You could also just remove those lines if it’s easier.
I think that will accomplish what you’re after. If not, let me know.
Jeremy,
Thanks a ton for this macro. I would like for it to “Do Unitl” if finds two blank cells in succession. I can make it work if only looking for first blank cell with Not IsEmpty(Cells(r, 3)). I have seen this before but cannot figure it out.
Thanks in advanced.
Guy
Brilliant piece of work – many thanks for making it available to us non-VBA types.
Tony
Hi Mark, from a real dummy,
Tried http://j.modjeska.us/data/wbs_numbering.xlsm, what next? Extracted the files does ot seem to work?
Hope I dont insult you.
Regards
Guy – Only 6 months late here with your answer, but here it is anyway because I think it’s a good idea.
This will eliminate the need for an “END OF PROJECT” flag, and instead it will stop numbering when it encounters two successive blank rows. This assumes your task descriptions are in Column B. If your task descriptions are in a different column, change the number 2 in the code below to the number corresponding to the desired column (C=3, D=4, etc.). I think the IsEmpty function might be Office 2007+ only, so YMMV on other versions.
Do While Not (IsEmpty(Cells(r, 2)) And IsEmpty(Cells(r + 1, 2)))
Hope that helps.
Etienne – Now sure what you’re asking, but the file is for Excel 2007. It may not work on other versions.
I downloaded this expecting a .xls or .xlsx file but got a zip file which expanded to a lot of files, but none that are Excel files. What am I missing? I guess I could retype the macro by hand from the screenshot but that seems error-prone. I have Excel 2007. In any case, thanks for making this available.
Tom: The only file linked here is a .xlsm (Macro-enabled Excel file). I don’t know what zip file you’re talking about.
Hi, just learning how to use VBA… How do I calculate “depth” if instead of indenting the subtasks as you described, I put each subtask into a new column? Any advice would be appreciated. Thank you!
Jun – I don’t have a full solution for you, but the following code should return the last used or “deepest” column in a given row. Replace the code on line 40 with this:
depth = Cells(r, 2).End(xlToRight).Column
This should return depth as a number corresponding to the last used column (A=1, B=2, etc). It’s going to consider *any* data in a column, so if there are static columns beyond the task descriptions (dates, resource names, etc), you’ll need to subtract those from “depth.”
Be careful with this method. Unless you put your task descriptions in the right-most column you could end up limiting your available subtask depth.
I naively tried just changing line 40 with what you provided for me. It runs into an infinite loop. No clue why… (I did try using your code using indents for subtasks and it totally works! Great code!!) Do think you help me come up with what I am missing? Thank you.
Sorry, it is not an infinite loop. When I stepped through, the new line 40 gave me depth=16,000.
Hello Jermey….
This is great :) yet when i tried it the numbering started not from the fisrt row that has my data yet it started with the below row, i.e. not row number 2 but 3. in addition the nubering starts with 0.1 not 1!!!! thats really odd! thought itried it to your example and it works just fine!!!
On the other hand, i type my data, the main one, on a cell in one column, and the sub ones on a different column, lets say: Main points are located in col. B and the sub are located on col. C… etc for other sub points. so no indentation happens.
So actually what I thought of is, since I enter the data in this way; I’m trying to do whenever there is a non blank data in a certain cell so this is a main point and shall take the first level of numbering (i.e. 1), while if its blank then those belong to the data that are supposedly sub points of the main one (1.1, 1.2, 1.3… etc, 2.1, 2.2,… etc).
I know I have to increase the numbering of the sub as well as the main one whenever a nonblank data occurs. Yet I cant do it in the simple if function, nor working for me when I VB script it! not to mention I’m not that good in scripting or VB!
I really have to get this done but I need a help from you, after all, you seem to be very expert in this :D
Please advise and help me out.
I’ll be waiting for your assistance, and if possible your solution.
Many thanks in advance and wish you a joyful day.
Regards,
Eve
thanks for this, the company i work for wont invest in Project, so this is the next best thing, cheers
Great code!
What would it take to be able to shift the cells down (insert a row above) without having the numbering column header become numbered.
Renumbering makes the 1st entry be “2″.
Thanks
Also,
The format forces some unwanted “bolds”. What would it take to remove these formatting changes?
Thanks