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 2009: 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 2009: I discovered (and have added to the code) the most effective trick ever for speeding up Excel macros: Application.ScreenUpdating = False.
Update April 6 2009: 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.
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