Note
Access to this page requires authorization. You can try signing in or changing directories.
Access to this page requires authorization. You can try changing directories.
Friday, March 11, 2011 11:50 PM
I am trying to simulate a functionality of MS Project in Excel. In Project, WBS number is sequenced and incremented based on the task and it's subtasks.
WBS Name
1 Task 1
1.1 Task 1.1
1.2 Task 1.2
2 Task 2
So, in Excel, I want the WBS column to generate the number as I add a new task and the numbering in WBS is set appropriately to 1.1, 1.2 based on the indentation of the task.
Is this possible? Would appreciate your help.
Thanks,
Lisa
Saturday, March 12, 2011 8:29 PM ✅Answered | 1 vote
Hi
I doubt this is possible with a formula. The code below will generate a WBS in column A if your tasks are listed in B (with headings).
Sub WBSnos()
Dim lvl1Counter As Integer
Dim lvl2Counter As Integer
Dim lvl3Counter As Integer
Dim InLevel As Integer
Dim WBSno As Double
lvl1Counter = 0
lvl2Counter = 0
lvl3Counter = 0
Range("B2").Select
Do While ActiveCell.Value <> ""
InLevel = ActiveCell.IndentLevel
Select Case IndentLevel
Case 0
lvl1Counter = lvl1Counter + 1
lvl2Counter = 0
lvl3Counter = 0
WBSno = lvl1Counter
Case 1
lvlCounter1 = lvl1Counter
lvl2Counter = lvl2Counter + 1
lvl3Counter = 0
WBSno = Val(lvl1Counter & "." & lvl2Counter)
Case 2
lvlCounter1 = lvl1Counter
lvl2Counter = lvl2Counter
lvl3Counter = lvl3Counter + 1
WBSno = Val(lvl1Counter & "." & lvl2Counter & lvl3Counter)
End Select
Selection.Offset(0, -1).Value = WBSno
Selection.Offset(1, 0).Select
Loop
End Sub
G North MMI
Monday, March 14, 2011 6:48 PM
Hello G North,
Thank you for your reply. I am fairly new with this. I believe I'm supposed to copy the code into Visual Basic.
I'm not sure where it should go and how to get it to work.
Lisa
Monday, March 14, 2011 8:49 PM | 1 vote
Hi
Open the VB Editor (Alt + F11).
From the menus select Insert, then Module. This will add a module to the project below the branches for the sheets in your workbook and display an empty code area to the right of this.
Copy the code in to this area. Once you've done this you can switch back to your spreadsheet and run the macro by pressinf Alt + F8 and selecting WBSno, and clicking Run.
You'll need a list of tasks with indents in column B. I was assuming you'd also have column headings so A1 would be WBS and B1 Task etc.
Hope this helps
G North MMI
Tuesday, March 15, 2011 12:51 AM
Got it. Thank you very much. I had to modify one of the variable names but other than that, it was perfect.
Tuesday, March 15, 2011 9:13 AM
Sorry about that glad your OK nowG North MMI
Tuesday, March 15, 2011 1:58 PM
Without a macro, assuming your headers are in A1:B1, task1 is in A2:B2, and you only have two levels as in your example
A3 =IF(LEN(B3),INT(A2)+1,A2+0.1)
and copy down
If there might be 10 or more sub entries at a given level, change the formula to
=IF(LEN(B3),INT(A2)+1,A2+0.01)
Peter Thornton
Wednesday, March 16, 2011 6:12 AM
Hi Peter,
The formula you provided did not give me the sub-level number. It increments the row by one but it does not give me the ".1" for the sub-tasks.
Thanks,
Lisa
Wednesday, March 16, 2011 7:43 AM
BTW, since I needed to have multiple levels (more than the 2 I listed), I changed WBSno to String so that I can concatenate more levels with "." in between.
Thursday, March 17, 2011 12:03 PM
Sorry Lisa, I misread the objective. The formula would work if your sub levels were in column C.
Here's another macro for you. It should handle an unlimited number of indents (up to the max 14). It should also cater for empty (blank) rows, but if you don't want it to do that post back.
Sub ParaNumbers()
Dim LastRow As Long
Dim i As Long, j As Long, k As Long
Dim ind As Long, maxLevel As Long, last As Long, nOffSet As Long
Dim sNum As String
Dim rng As Range, c As Range, rngNumbers As Range
Set rng = Range("B2")
LastRow = rng.Offset(10000).End(xlUp).Row
If LastRow <= rng.Row Then
MsgBox "There does not appear to be a list of values below " _
& rng.Address(0, 0)
Exit Sub
End If
' nom columns to left or right for the numbers, normally -1
nOffSet = -1
' maybe check (rng.Column - nOffset > 0) to ensure on the sheet
Set rng = rng.Resize(LastRow)
ReDim arrLevel(1 To rng.Rows.Count) As Long
For Each c In rng
i = i + 1
If Len(c) Then
ind = c.IndentLevel
arrLevel(i) = c.IndentLevel + 1
If arrLevel(i) > maxLevel Then maxLevel = arrLevel(i)
End If
Next
Set rngNumbers = rng.Offset(0, nOffSet)
rngNumbers.NumberFormat = "@" ' format as text
ReDim arrNumber(1 To maxLevel) As Long
For i = 1 To UBound(arrLevel)
If arrLevel(i) > 0 Then
If arrLevel(i) > last Then
arrNumber(arrLevel(i)) = 1
If arrLevel(i) > 1 Then
For j = 1 To arrLevel(i) - 1
If arrNumber(j) = 0 Then
arrNumber(j) = 1
End If
Next
End If
Else
arrNumber(arrLevel(i)) = arrNumber(arrLevel(i)) + 1
For j = last + 1 To maxLevel
arrNumber(j) = 0
Next
End If
last = arrLevel(i)
sNum = arrNumber(1)
For k = 2 To last
sNum = sNum & "." & arrNumber(k)
Next
rngNumbers(i) = sNum
Else
' empty row
rngNumbers(i).Clear
End If
Next
End Sub
Peter Thornton
PS, I've been having a lot of problems this end to sign in of late, so may not be able to follow up immediately.
Tuesday, March 29, 2011 10:15 PM
Thanks, Peter. I have not had a chance to try your macro yet yet but I am interested. I will try and let you know.
Lisa
Saturday, April 6, 2019 11:59 PM
Hi Peter,
This macro worked great for me except for one thing. Since I'm doing a compare on this WBS result, anything greater than 9 doesn't work. Is there a way to put a leading 0 for single digit levels such as 1.01.01?
Thanks,
Damon