A new version has been uploaded (use the same link above) that now includes
an 'auto-repair' feature - if you delete or add in new paragraphs, all
affected paragraph numbers are revised.

Rather than posting all the code, I'll just say: grab the workbook and use
it, modify code as needed per the instructions on the sheet in it.

Enjoy

"JLatham" wrote:

Ok, you intrigued me - I'd never thought of automating this, but said "why
not, especially since it would be a tool I could use in my work also".

I've coded up a somewhat primitive solution that will "automatically" create
such paragraph numbering using individual columns to display them. That is,
columns would display numbering as:
column A: 1. , 2. , 3. etc.
column B: 1.1, 1.2, 1.3, 2.1 etc.
column C: 1.1.1, 1.1.2, 2.1.1, 3.1.1, 3.1.2, etc
column D: 1.1.1.1, 1.1.2.1, 2.1.2.1, etc.

It uses the worksheet's _BeforeDoubleClick event to deal with this. You
double-click in one of the defined columns (which you can redefine) and it
will put an appropriate number in it, based on earlier entries. It is not
'self-correcting' as is Word just yet. But I may play with that some more
today - quite a bit of checking to do if you insert a new paragraph 5.
between what used to be 4. and 5. and currently you end up with 4. 5. and 5.
without the 2nd 5. updating to 6. as it would have in Word.

Here is a link to the workbook - just click and save to your hard drive.
You can copy the sheet into any other workbook - the functionality goes with
it.
http://www.jlathamsite.com/teach/Aut...hNumbering.xls
The workbook has sample results on the sheet, along with description of
operation, limitations, etc on it. You can delete everything on that sheet
and start formatting it up the way you want - none of the current entries
have to remain on it, they're just there for info/demo purposes.

For the rest of the world, here's the code - it goes into a worksheet's code
section: right-click on worksheet name tab and choose [View Code] and then
copy this code into the displayed code module in the VB Editor.

Option Explicit
'create by J.Latham
'email:
'
'Presently set up to handle up to 4 levels of paragraph numbering
'by double-clicking in a column included in rngNumbering,
'it will automatically assign next number for that level
'As now set up only works where all paragraph levels are
'to appear in single-letter colums: A through Z.
'and increasing levels must work from left to right
'and all must be an adjoining/contiguous group.
'
'alter values of these Const declarations to
'custom tailor the processes for your
'worksheet.
'set this to row that 1st major paragraph
'number may appear in. This allows you
'to "protect" header rows
Const firstParagraphRow = 2
'list of columns involved:
' must be single letter columns (A-Z only) and
' must be adjacent columns as "A:D" or "F:K"
Const rngNumbering = "A:D"
'MUST agree with rngNumbering with one letter entry,
'in sequence for each column included in rngNumbering
Const usedColumns = "ABCD" ' better agree with rngNumbering!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim tmpColID As String
Dim relativeColNumber As Integer

If Application.Intersect(Target, Range(rngNumbering)) Is Nothing Then
Exit Sub ' not in a column listed in rngNumbering
End If
If Target.Row < firstParagraphRow Then
Exit Sub ' in protected area
End If
'have to figure out which column we are talking about
tmpColID = Right(Target.Address, Len(Target.Address) - 1) ' $A$2 becomes A$2
tmpColID = Left(tmpColID, InStr(tmpColID, "$") - 1)
relativeColNumber = InStr(usedColumns, tmpColID)
Select Case relativeColNumber
Case Is = 1
'first/Major column is the easy one
Target.Value = ProcessMajorColumn(Target, _
Mid(usedColumns, relativeColNumber, 1))
Case Is 1
Target.Value = ProcessMinorColumns(Target, _
Mid(usedColumns, relativeColNumber, 1), _
Mid(usedColumns, relativeColNumber - 1, 1), _
relativeColNumber)
Case Else
'zero or negative values
'should be impossible,
'but might be if setup has error in it
End Select
Cancel = True ' cancel double-click action
End Sub

Private Function ProcessMajorColumn(Target As Range, colID As String) As
String
Dim rngColumn As Range
Dim anyCell As Object
Dim lastValue As Integer
Dim ckLoop As Integer

'may not appear on same row with any lesser level entry
For ckLoop = 1 To (Len(usedColumns) - 1)
If Not IsEmpty(Target.Offset(0, ckLoop)) Then
'not allowed on same row with lesser level entry
Exit Function
End If
Next
'force to Text format
Target.NumberFormat = "@"
If Target.Row = firstParagraphRow Then
ProcessMajorColumn = "1."
Exit Function
End If
Set rngColumn = Range(colID & firstParagraphRow & ":" _
& colID & Target.Row - 1)
For Each anyCell In rngColumn
If Not IsEmpty(anyCell) Then
lastValue = Val(Left(anyCell.Value, InStr(anyCell.Value, ".") - 1))
End If
Next
ProcessMajorColumn = Trim(Str(lastValue + 1)) & "."
End Function

Private Function ProcessMinorColumns(Target As Range, clCol As String, _
plCol As String, relCol As Integer) As String
'clCol = current level column identifier
'plCol = previous level column identifier
'relCol = relative column number - to permit checking for prior entries
' on the same row (not permitted). It is also the level indicator.

Dim rngColumn As Range
Dim anyCell As Object
Dim lastCurrentLvlEntry As String
Dim lastCurrentLvlValue As Integer
Dim lastPriorLvlEntry As String
Dim lastTopLvlEntry As String
Dim TopLvlCol As String
Dim ckLoop As Integer

'tests required:
' no entries in previous columns on same row
' what is last value in current column (clCol) and
' what is last value in previous column (plCol).
'Must figure things out from those values
'as to what to put in this cell

'find last entry in this column
'has to be below row in firstParagraphRow plus
'offset for this level of paragraph number
If Target.Row < firstParagraphRow + (relCol - 1) Then
Exit Function
End If

'cannot appear on same row with any higher level
'paragraph number
For ckLoop = -1 To -(relCol - 1) Step -1
If Not IsEmpty(Target.Offset(0, ckLoop)) Then
'not allowed on same row with major level
Exit Function
End If
Next ' ckLoop end
'by the same logic, it cannot appear on same row
'with any already existing lower level para#
If relCol < Len(usedColumns) Then
For ckLoop = 1 To (Len(usedColumns) - relCol)
If Not IsEmpty(Target.Offset(0, ckLoop)) Then
'not allowed on same row with lesser level entry
Exit Function
End If
Next
End If

TopLvlCol = Left(usedColumns, 1)
lastTopLvlEntry = ""
Set rngColumn = Range(TopLvlCol & firstParagraphRow _
& ":" & TopLvlCol & Target.Row - 1)
For Each anyCell In rngColumn
If Not IsEmpty(anyCell) Then
lastTopLvlEntry = anyCell.Value
End If
Next
If lastTopLvlEntry = "" Then
Exit Function
End If

'There MUST be an entry in column to the left on a row
'above this row and below firstParagraphRow + this level -2
Set rngColumn = Range(plCol & (firstParagraphRow + (relCol - 2)) _
& ":" & plCol & Target.Row - 1)
'find last previous level entry
For Each anyCell In rngColumn
If Not IsEmpty(anyCell) Then
If Len(anyCell.Value) 0 Then
' just need last one
lastPriorLvlEntry = anyCell.Value
End If
End If
Next
If lastPriorLvlEntry = "" Then
'no previous level entry
Exit Function
End If
If lastTopLvlEntry < Left(lastPriorLvlEntry, Len(lastTopLvlEntry)) Then
'no valid prior level entry to make new para# from
Exit Function
End If
Target.NumberFormat = "@"
Set rngColumn = Range(clCol & firstParagraphRow + 1 & ":" & _
clCol & Target.Row - 1)
lastCurrentLvlValue = 0 ' initialize
For Each anyCell In rngColumn
If Not IsEmpty(anyCell) Then
If Len(anyCell) 0 Then
lastCurrentLvlEntry = anyCell.Value
'last level number at this level used
lastCurrentLvlValue = Val(Right(anyCell.Value, _
Len(anyCell.Value) - InStrRev(anyCell.Value, ".")))
End If
End If
Next
If Right(lastPriorLvlEntry, 1) < "." Then
lastPriorLvlEntry = lastPriorLvlEntry & "."
End If
If Left(lastCurrentLvlEntry, Len(lastPriorLvlEntry)) = lastPriorLvlEntry
Then
ProcessMinorColumns = lastPriorLvlEntry & Trim(Str(lastCurrentLvlValue +
1))
Else
ProcessMinorColumns = lastPriorLvlEntry & "1"
End If
End Function


"BCNU" wrote:

I am trying to tie a Work Breakdown Structure in Project to a Statement of
work in Word and track costs in Excel. The statement of work uses paragraph
numbers like 1.0, 1.1, 1.1.1, 1.2 etc. Is there a way to have excel autofill
or genrate these numbers (like word does)?
--
Thanx