Automatic WBS Indenture 1

[KenWright]

Just a tip that may be of use to somebody, only I'm finding that I'm using this more and more each day now. For those of you that work with WBS structures, or Work Breakdown Structures, eg the sort of thing you get in Microsoft Project where you have a structure that lists all the tasks in a hierarchical order. Very often I end up working with that same structure in Excel, whether it be a dump from Project, or a structure to upload into another system, eg ProPricer. Generally, that structure will look as follows, which is fine from the WBS side of things, but personally I hate the look of because I can't see the tiering reflected in the descriptions, so I find it very hard to follow, eg

ID    DESCRIPTION WBS
-------------------------------
1	 A_SYSTEM    A
2	 SYS1        A.01
3	 Labour WPs  A.01.01
4	 Prog Mgmt   A.01.01.01
5	 Sys Eng     A.01.01.01.01
6	 ILS         A.01.01.01.02
7	 QA          A.01.01.01.02
8	 Other1      A.01.01.01.03
9	 Other2 etc  A.01.01.01.04
10	SYS2        A.02
11	Labour WPs  A.02.01
12	Prog Mgmt   A.02.01.01
13	Sys Eng     A.02.01.01.01
14	ILS         A.02.01.01.02
15	QA          A.02.01.01.02
16	Other1      A.02.01.01.03
17	Other2 etc  A.02.01.01.04

Well, personally I hate that, and I very very much prefer to see the data in a tiered view such as this:-

ID    DESCRIPTION       WBS
-------------------------------------
1	 A_SYSTEM         A
2	   SYS1           A.01
3	     Labour WPs   A.01.01
4	       Prog Mgmt  A.01.01.01
5	       Sys Eng    A.01.01.01.01
6	       ILS        A.01.01.01.02
7	       QA         A.01.01.01.02
8	       Other1     A.01.01.01.03
9	       Other2 etc A.01.01.01.04
10	  SYS1           A.02
11	    Labour WPs   A.02.01
12	      Prog Mgmt  A.02.01.01
13	      Sys Eng    A.02.01.01.01
14	      ILS        A.02.01.01.02
15	      QA         A.02.01.01.02
16	      Other1     A.02.01.01.03
17	      Other2 etc A.02.01.01.04

That looks far more logical to me, and seems so much easier to work with, and after getting annoyed for so long decided it was worth a few minutes to write a simple routine that would do that for me. The routine however, depends on your WBS structure having a typical format such as the above, with a period separating the levels. Doesn't matter what the format of the levels is, but there is a separator in there (Can easily be changed if you use something else).

The following code assumes you would select all your descriptions, run the code, and then be prompted to select any cell in your WBS column and hit OK. It then runs through each line and based on the level of indenture it gets from the number of separators, it will indent your decsriptions in line with the WBS.

Sub WBSIndent()
Dim rng As Range
Dim cel As Range
Set rng = Selection

DescCol = rng.Column
Set Cell = Application.InputBox("Select any single cell in the WBS column", Type:=8) WbsCol = Cell.Column ofs = WbsCol - DescCol

With ActiveCell
    .Font.Bold = True
    .Offset(0, ofs).Font.Bold = True
End With

For Each cel In rng
    With cel
        sString = .Offset(0, ofs).Value
        lstr1 = Len(sString)
        sString = Replace(sString, ".", "")
        lstr2 = Len(sString)
        x = lstr1 - lstr2
        .IndentLevel = x
    End With
Next

'Routine below Bolds all the top levels - Comment out if not wanted For Each cel In rng
    With cel
        x = .IndentLevel
        y = .Offset(1, 0).IndentLevel
        If x < y Then
            .Font.Bold = True
            .Offset(0, ofs).Font.Bold = True
        End If
    End With
Next

rng.Columns.AutoFit
ActiveCell.Select
Application.ScreenUpdating = True
End Sub

If you then need to lose the indenture for any reason, eg added new rows and want to reindent etc, just select decsriptions again and run:-

Private Sub WBSOutdent()
Dim rng As Range
Dim cel As Range
Set rng = Selection

For Each cel In rng
    With cel
        .IndentLevel = 0
        .Font.Bold = False 'Comment out if you want to leave bold
    End With
Next
rng.Columns.AutoFit
ActiveCell.Select
Application.ScreenUpdating = True
End Sub

Regards
Ken...........


----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
----------------------------------------------------------------------------

 

[KenWright]

Damn wordwrap - I know it will be obvious to most, but the "For Each Cel in Range" bit got mixed up with the comment

Should have been

Sub WBSIndent()
Dim rng As Range
Dim cel As Range
Set rng = Selection

DescCol = rng.Column
Set Cell = Application.InputBox("Select any single cell in the WBS column", Type:=8) WbsCol = Cell.Column ofs = WbsCol - DescCol

With ActiveCell
    .Font.Bold = True
    .Offset(0, ofs).Font.Bold = True
End With

For Each cel In rng
    With cel
        sString = .Offset(0, ofs).Value
        lstr1 = Len(sString)
        sString = Replace(sString, ".", "")
        lstr2 = Len(sString)
        x = lstr1 - lstr2
        .IndentLevel = x
    End With
Next

'Routine below Bolds all the top levels - Comment out if not wanted 

For Each cel In rng
    With cel
        x = .IndentLevel
        y = .Offset(1, 0).IndentLevel
        If x < y Then
            .Font.Bold = True
            .Offset(0, ofs).Font.Bold = True
        End If
    End With
Next

rng.Columns.AutoFit
ActiveCell.Select
Application.ScreenUpdating = True
End Sub

Regards
Ken...........

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
----------------------------------------------------------------------------