Create a numbering system by levels

F

FryGirl

Well-known Member
Joined
Nov 11, 2008
Messages
1,364
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Is there any way to create a list of numbers based on the level value in column A?

<TABLE style="WIDTH: 96pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=128><COLGROUP><COL style="WIDTH: 33pt; mso-width-source: userset; mso-width-alt: 1609" width=44><COL style="WIDTH: 63pt; mso-width-source: userset; mso-width-alt: 3072" width=84><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 33pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl77 height=20 width=44>Level</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 63pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl77 width=84>Number</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl71 height=20>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl76>1.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.1.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.1.2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.1.3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.1.4</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.1.5</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl74>1.1.5.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl74>1.1.5.2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.1.6</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl71 height=20>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl76>1.2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.2.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.2.2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl74>1.2.2.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl74>1.2.2.2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl74>1.2.2.3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl74>1.2.2.4</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl71 height=20>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl76>1.3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl72>1.3.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl72>1.3.2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl71 height=20>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND: #bfbfbf; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid; mso-pattern: black none" class=xl76>1.4</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl73>1.4.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl74>1.4.2.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>4</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl75>1.4.2.1.1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl71 height=20>4</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl75>1.4.2.1.2</TD></TR></TBODY></TABLE>
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
I have a function that does this:

Code: 
       --A-- ---B---
   1   Level Number 
   2       1 1      
   3       2 1.1    
   4       2 1.2    
   5       2 1.3    
   6       2 1.4    
   7       2 1.5    
   8       3 1.5.1  
   9       3 1.5.2  
  10       2 1.6    
  11       1 2      
  12       2 2.1    
  13       2 2.2    
  14       3 2.2.1  
  15       3 2.2.2  
  16       3 2.2.3  
  17       3 2.2.4  
  18       1 3      
  19       2 3.1    
  20       2 3.2    
  21       1 4      
  22       2 4.1    
  23       3 4.1.1  
  24       4 4.1.1.1
  25       4 4.1.1.2
The formula in B2 and copied down is

=NextWBS(A2, B$1:B1)

The function is

Code: 
Function NextWBS(ByVal iLevel As Long, rWBS As Range, _
                 Optional nDigits As Long = 1, _
                 Optional iDigit As Long = -1) As String
    ' shg 2008-1105, 2008-1112

    Dim iRow    As Long
    Dim sFmt    As String
    Dim asWBS() As String
 
    If iLevel = 0 Then Exit Function    ' (null string) ----------------------->
 
    ' get the last WBS
    For iRow = rWBS.Rows.Count To 1 Step -1
        If IsWBS(rWBS(iRow).Text, asWBS) Then Exit For
    Next iRow
 
    If iRow = 0 Then   ' no valid WBS string found above
        NextWBS = IIf(iDigit = -1, "1", CStr(iDigit))
        Exit Function   ' ----------------------------------------------------->
    End If
 
    iLevel = iLevel - 1                         ' make iLevel 0-based, like astr
    
    If iLevel < 0 Or iLevel > UBound(asWBS) + 1 Then
        NextWBS = "#LEVEL!"
        Exit Function   ' ----------------------------------------------------->
    End If
   
    sFmt = String(IIf(nDigits < 1, 1, nDigits), "0")    ' create format string
    ReDim Preserve asWBS(0 To iLevel)
 
    If iDigit = -1 Then
        ' WBS element unspecified; increment current level
        If Len(asWBS(iLevel)) = 0 Then asWBS(iLevel) = "0"
        asWBS(iLevel) = Format((CLng(asWBS(iLevel)) + 1), IIf(iLevel = 0, "0", sFmt))
        NextWBS = Join(asWBS, ".")
    Else
        ' WBS element number specified
        asWBS(iLevel) = Format(iDigit, sFmt)
        ' form the string and check for duplicates in range above
        NextWBS = Join(asWBS, ".")
        On Error Resume Next
        iRow = WorksheetFunction.Match(NextWBS, rWBS, 0)
        If Err.Number = 0 Then NextWBS = NextWBS & " #DUP! in row " & rWBS(iRow).Row
    End If
End Function
 
Private Function IsWBS(s As String, asWBS() As String) As Boolean
    ' If s is a valid WBS string,
    ' returns s split by periods in asWBS
    ' else returns Empty
 
    Dim i       As Long
 
    If Len(s) = 0 Then Exit Function
    asWBS = Split(s, ".")
    For i = 0 To UBound(asWBS)
        If Not IsNumeric(asWBS(i)) Then Exit Function
    Next i
    IsWBS = True
End Function
 
Upvote 0
This UDF takes a more local approach
In B2, put =IncrimentHString(B2, A3) and drag down


Code: 
Const delimiter As String = "."

Function IncrimentHString(ByVal HString, incrimentLevel As Long) As String
    IncrimentHString = HArrayToHString(IncrimentHArray(HStringToHArray(HString), incrimentLevel))
End Function

Function IncrimentHArray(ByVal HArray As Variant, incrimentLevel As Long) As Variant
    ReDim Preserve HArray(0 To incrimentLevel)
    HArray(incrimentLevel) = Val(HArray(incrimentLevel)) + 1
    IncrimentHArray = HArray
End Function

Function HStringToHArray(ByVal strDisplay As String) As Variant
    HStringToHArray = Split(delimiter & strDisplay, delimiter)
End Function

Function HArrayToHString(ByVal HArray As Variant) As String
    Dim i As Long
    For i = 1 To UBound(HArray)
        If HArray(i) = 0 Then Exit For
    Next i
    
    ReDim Preserve HArray(0 To i - 1)
    
    HArrayToHString = Mid(Join(HArray, delimiter), Len(delimiter) + 1)
End Function
 
Upvote 0
This is a bit more optimal.
B2 holds the formula =IncrimentHeirarch(B1, A2+1) dragged down.

Code: 
Function IncrimentHeirarchy(ByVal HString As Variant, incrimentLevel As Long) As Variant
    Const Delimiter As String = "."
    Dim HArray As Variant
    Dim i As Long, Low As Long
    
    incrimentLevel = incrimentLevel
    
    HArray = Split(Delimiter & HString, Delimiter)
    Low = UBound(HArray)
    
    ReDim Preserve HArray(0 To incrimentLevel)
    HArray(incrimentLevel) = Val(HArray(incrimentLevel)) + 1
    
    For i = Low To UBound(HArray)
        If Not IsNumeric(HArray(i)) Then HArray(i) = 1
    Next i
    
    IncrimentHeirarchy = Mid(Join(HArray, Delimiter), Len(Delimiter) + 1)
End Function
B2 holds the formula =IncrimentHeirarch(B1, A2+1) dragged down.
 
Upvote 0
Very nice also mikerickson, thanks for sharing
 
Upvote 0
Since you are employing VB code anyway, I thought you might like to have a macro to produce your (chapter) Number list instead of loading up your worksheet with UDF formulas. In the following macro, you need to set the three constants (the Const statements) to match your actual setup (StartRow should be obvious; Levels and Numbers are the column letters each of those list should be outputted to)...
Code: 
Sub MakeChapters()
  Dim X As Long, LastRow As Long, FirstChapterNumber As String, Joined As String, Temp As String, Chapters() As String
  Const StartRow As Long = 2
  Const Levels As String = "A"
  Const Numbers As String = "B"
  Columns(Numbers).NumberFormat = "@"
  FirstChapterNumber = "1" & Left(Replace(String(99, "X"), "X", ".1"), 2 * Cells(StartRow, Levels).Value)
  LastRow = Cells(Rows.Count, Levels).End(xlUp).Row
  Cells(StartRow, Numbers).Value = FirstChapterNumber
  For X = StartRow + 1 To LastRow
    Chapters = Split(Cells(X - 1, Numbers).Value, ".")
    If Cells(X, Levels).Value >= UBound(Chapters) + 1 Then
      Cells(X, Numbers).Value = Cells(X - 1, Numbers).Value & Replace(String(Cells(X, Levels).Value - UBound(Chapters), "X"), "X", ".1")
    Else
      ReDim Preserve Chapters(0 To Cells(X, Levels).Value)
      Chapters(UBound(Chapters)) = Val(Chapters(UBound(Chapters))) + 1
      Cells(X, Numbers).Value = Join(Chapters, ".")
    End If
  Next
End Sub
If you want, you can use a Level number of 0 at any time (including at the start of the Level list) to start a new, non-dotted (chapter) Number sequence (that is, a 1 or 2 or 3 etc.). If you start the Level list with 0, then the (chapter) Number list will start with 1; if you start the Level list with 1, then the (chapter) Number list will start with 1.1; if you start the Level list with 2, then the (chapter) Number list will start with 1.1.1; etc Note that all of this functionality matches that implemented in mikerickson's UDF.
 
Upvote 0
Thanks Rick this works nice also.

One question, how could the macro be modified if you want to start with a number other than 1.1

So as an example
3.1
3.1.1
3.1.2
3.1.3
3.1.4
3.1.5
 
Upvote 0
FryGirl said:
One question, how could the macro be modified if you want to start with a number other than 1.1

So as an example
3.1
3.1.1
3.1.2
Click to expand...
Here is my modified macro. I added a ChapterStartNumber constant that will allow you to set it. If you want this to be more interactive, I could exchange that for an InputBox that would ask you what chapter number you wanted to start at... just let me know.
Code: 
Sub MakeChapters()
  Dim X As Long, LastRow As Long, FirstChapterNumber As String, Joined As String, Temp As String, Chapters() As String
  Const StartRow As Long = 2
  Const Levels As String = "A"
  Const Numbers As String = "B"
  Const ChapterStartNumber As Long = 3
  Columns(Numbers).NumberFormat = "@"
  FirstChapterNumber = CStr(ChapterStartNumber) & Left(Replace(String(99, "X"), "X", ".1"), 2 * Cells(StartRow, Levels).Value)
  LastRow = Cells(Rows.Count, Levels).End(xlUp).Row
  Cells(StartRow, Numbers).Value = FirstChapterNumber
  For X = StartRow + 1 To LastRow
    Chapters = Split(Cells(X - 1, Numbers).Value, ".")
    If Cells(X, Levels).Value >= UBound(Chapters) + 1 Then
      Cells(X, Numbers).Value = Cells(X - 1, Numbers).Value & Replace(String(Cells(X, Levels).Value - UBound(Chapters), "X"), "X", ".1")
    Else
      ReDim Preserve Chapters(0 To Cells(X, Levels).Value)
      Chapters(UBound(Chapters)) = Val(Chapters(UBound(Chapters))) + 1
      Cells(X, Numbers).Value = Join(Chapters, ".")
    End If
  Next
End Sub
 
Upvote 0
Hi Rick,

This is wonderful.

For the InputBox, I think I should be able to add it, but I'll come calling if I run into trouble.

This works for me, but need to add some error checking if they don't fill in the InputBox

Code: 
Sub MakeChapters()
    Dim X As Long, LastRow As Long, FirstChapterNumber As String, Joined As String, Temp As String, Chapters() As String
    Dim ChapterStartNumber As Variant
    Const StartRow As Long = 2
    Const Levels As String = "A"
    Const Numbers As String = "B"
'    Const ChapterStartNumber As Long = 3
    ChapterStartNumber = VBA.InputBox("How many rows would you like to add?")
    Columns(Numbers).NumberFormat = "@"
    FirstChapterNumber = CStr(ChapterStartNumber) & Left(Replace(String(99, "X"), "X", ".1"), 2 * Cells(StartRow, Levels).Value)
    LastRow = Cells(Rows.Count, Levels).End(xlUp).Row
    Cells(StartRow, Numbers).Value = FirstChapterNumber
    For X = StartRow + 1 To LastRow
        Chapters = Split(Cells(X - 1, Numbers).Value, ".")
        If Cells(X, Levels).Value >= UBound(Chapters) + 1 Then
            Cells(X, Numbers).Value = Cells(X - 1, Numbers).Value & Replace(String(Cells(X, Levels).Value - UBound(Chapters), "X"), "X", ".1")
        Else
            ReDim Preserve Chapters(0 To Cells(X, Levels).Value)
            Chapters(UBound(Chapters)) = Val(Chapters(UBound(Chapters))) + 1
            Cells(X, Numbers).Value = Join(Chapters, ".")
        End If
    Next
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
846
gvsumich
G
E
  • Question
VBA for Web Scraping help
Replies
0
Views
600
epactheactor
E
M
  • Question
TEXTAFTER with textbefore...to extract number or series of numbers.
2
Replies
12
Views
415
mad3
M
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C

Forum statistics

Threads
1,215,219
Messages
6,123,687
Members
449,117
Latest member
Aaagu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top