Excel VBA Code - Create Structured Numbering using Row Outline Level

Andrew O'Connor
Relken Engineering
Have a question or want to speak with Andrew O'Connor ? Contact us with your details.

Structured Numbers using VBADescription

This VBA Code automatically creates a structured list number, based on the Outline Level of the rows. This is useful when creating project plans, FMECAs, Work Breakdown Structures or any other structured list of items in excel such as the asset structure shown on the right. When adding new rows or changing the hierarchy of the data, the structured list ID will automatically update (after a recalculation is applied).  To read about how to use MS Excel's outline levels to manage and visualise structured data, see Excel Tip: Collapsing rows with structured data.

Features

This VBA code will create a structured number list automatically, based on the outline level of each row. 

The code has the following additional functions:

  • The user may select which cell the previous number is obtained from.
  • The user may select to skip a level.
  • When no 'previous cell' is provided, the function will automatically search for the next non-blank cell above it to use. This allows rows to be added  and deleted without breaking the formulas.

Use

To use this function where the structured numbers are vertical, and have a dedicated column of data:

  • Set the Outline Level of each row within your spreadsheet. For instructions on how to do this, see article: Excel Tip: Collapsing rows with structured data
  • Set the first value of the structured number list (ie. '1.')
  • In the desired cells type =WBSNumbering().
  • Press Alt-Shift-F9 to recalculate complete sheet. 
  • The structured numbers should automatically appear.

NOTE:  If you make changes to the row level and wish the number to update, you will need to recalculate the sheet by pressing Alt-Shift-F9.

To set the previous cell from which the current will be calculated, type  =WBSNumbering(PCell), where PCell is a reference to the previous cell.

To set the cell for which the structured number will be calculated, type   =WBSNumbering(PCell, CCell), where CCell is the current cell for which the structured number is being calculated. 

To skip a level within the structured number, type  =WBSNumbering(PCell, CCell, SkipNum), where SkipNum is the level which will be skipped. 

Example

Using a asset structure example, after I set the Outline Level for each row, I inserted the formula '=WBSNumbering()' in each cell to create the ID number.  If I wish to add a row into the sheet as 1.2 called 'Chassis' I can simply add a row at row 7, set it to the correct level, press Shift-Alt-F and the ID number will automatically update.

Automatic structured numbering in Excel using VBA     Adding a row into structured numbering

Related Functions

The following articles are related to this function:

File Attachment: 
PreviewAttachmentSize
Relken Excel Tip - Outline Levels_1.xlsm98 KB
  1. Function WBSNumbering(Optional pCell As Range, Optional cCell As Range, Optional SkipNum As Variant)
  2. ' WBSNUMBERING takes the previous WBS number (pCell) and creates a new WBS number, based on the outline
  3. ' level of the current cell (cCell). The first cell in the workbook must be a structured number (i.e '1.').
  4. ' When used as =WBSNumbering(), the function sets pCell as the last cell in the column with a value and
  5. ' cCell as the current cell from which the function has been called. These values can be set manually.
  6. ' The SkipNum value means the function will skip a level when calculating the output.
  7. '
  8. 'SYNTAX
  9. ' =WBSNumbering() is the default to create a vertical structured number list
  10. ' =WBSNumbering(A1) sets the previous cell for which the structured number increases from
  11. ' =WBSNumbering(A1,A20) sets the previous and the current cell to calculate the new structured number
  12. ' =WBSNumbering(A1,A20,3) will skip level 3 increases
  13. '
  14. 'EXAMPLE
  15. ' Let A1 = "1."
  16. ' =WBSNumbering(A1) in a row with outline level set to 0 equals "2."
  17. ' =WBSNumbering(A1) in a row with outline level set to 1 equals "1.1"
  18. ' =WBSNumbering(A1) in a row with outline level set to 2 equals "1.1.1"
  19.  
  20. ' Author: Andrew O'Connor <andrew.oconnor@relken.com>
  21. ' Date: 05 Apr 2013
  22. ' Copyright: 2014 Relken Engineering
  23.  
  24. Dim c As Variant 'Cell used in loop
  25. Dim cdepth As Long 'Depth of current WBS (based on outline level
  26. Dim pdepth As Long 'Depth of previous WBS (based on outline level)
  27. Dim startLevel As Long 'The difference between the outline level and actual level
  28. Dim dotpos As Long 'The position of the dot
  29. Dim pValue As String 'Previous WBS Value
  30. Dim i As Long 'Loop counter
  31. Dim wbsarray() As Long 'Master array holds counters for each WBS level
  32. Dim WBS As String 'The WBS string for each task
  33. Dim endwithstop As Boolean 'True if the WBS item ends in a fullstop
  34.  
  35. 'If Cells references not provided add them
  36. If pCell Is Nothing Then
  37. Set pCell = Application.Caller.Offset(-1, 0)
  38. End If
  39. If pCell.Value = "" Then
  40. Set pCell = pCell.End(xlUp)
  41. End If
  42.  
  43. If cCell Is Nothing Then
  44. Set cCell = Application.Caller
  45. End If
  46.  
  47. 'Get the previous value
  48. pValue = CStr(pCell.Value)
  49. If pValue = "" Then
  50. cCell.NumberFormat = "@"
  51. cCell.Errors(xlNumberAsText).Ignore = True
  52. WBSNumbering = "1"
  53. Else
  54.  
  55. 'Determine if trailing fullstops are being used
  56. endwithstop = Right(pValue, 1) = "."
  57. If Not endwithstop Then
  58. pValue = pValue & "."
  59. End If
  60.  
  61. 'Get Current Depth
  62. cdepth = Rows(cCell.Row).OutlineLevel
  63.  
  64. 'Get Previous Cell Counter Based on Number of Dots
  65.  
  66. i = -1
  67. dotpos = 1
  68. Do While dotpos > 0
  69. i = i + 1
  70. ReDim Preserve wbsarray(i)
  71. dotpos = InStr(pValue, ".")
  72. If dotpos - 1 > 0 Then
  73. wbsarray(i) = CLng(Left(pValue, dotpos - 1))
  74. pValue = Mid(pValue, dotpos + 1)
  75. Else
  76. wbsarray(i) = 0
  77. End If
  78. Loop
  79. pdepth = i
  80.  
  81. 'Get previous level
  82. startLevel = pdepth - pCell.Rows.OutlineLevel
  83. cdepth = cdepth + startLevel
  84.  
  85. 'Prepare Next WBS Counter
  86. 'Note Counter will have correct elements, but may still be too long
  87. If cdepth = pdepth Then
  88. wbsarray(pdepth - 1) = wbsarray(pdepth - 1) + 1
  89. ElseIf cdepth > pdepth Then
  90. For i = pdepth To cdepth - 1
  91. ReDim Preserve wbsarray(i)
  92. wbsarray(i) = 1
  93. Next i
  94. Else 'cdepth < pdepth
  95. wbsarray(cdepth - 1) = wbsarray(cdepth - 1) + 1
  96. End If
  97.  
  98. 'Create String
  99. WBS = CStr(wbsarray(0))
  100. If cdepth > 0 Then
  101. For aloop = 1 To cdepth - 1
  102. WBS = WBS & "." & CStr(wbsarray(aloop))
  103. Next aloop
  104. If endwithstop Then
  105. WBS = WBS & "."
  106. End If
  107. End If
  108.  
  109. 'Get Skip Levels
  110. If IsMissing(SkipNum) = False Then
  111. If IsNumeric(SkipNum) Then
  112. If cdepth = SkipNum Then
  113. WBS = WBS & "1."
  114. End If
  115. Else
  116.  
  117. For Each c In SkipNum
  118. If cdepth = CLng(c.Value) Then
  119. WBS = WBS & "1."
  120. End If
  121. Next c
  122. End If
  123. End If
  124.  
  125. 'Make Current Cell into Text
  126. cCell.NumberFormat = "@"
  127.  
  128. 'Get rid of annoying "number stored as text" error
  129. cCell.Errors(xlNumberAsText).Ignore = True
  130.  
  131. 'Put WBS String into Value
  132. 'cCell.Value = wbs
  133. WBSNumbering = WBS
  134.  
  135. End If
  136.  
  137. End Function

Comments

Submitted by Raphael Souza (not verified) on

That's exactly what I was looking for, thanks a lot!

Just by curiosity, how did you insert the relken logo behind all cells on normal exibition mode?