Auto number when a row is inserted

[FireBott]

Good Afternoon. I have a spreadsheet to collect the necessary activities to onboard a new client. There will be approximately 7 people making contributions to the spreadsheet on a shared drive. The end result will eventually become a project plan/timeline. The spreadsheet is in a table format with 801 rows (Table 4 = B1:J801), the first row being the header. The rows are automatically numbered using =row(B1); column name Activity ID. However, there will be times that a user will need to insert a row which will mess up the Activity ID sequence. Is there a formula or code that when a row is inserted, the Activity ID number will populate sequentially using the last number populated at the end of the table?

For example, The last row in the table is numbered 800, if a user inserts a row in between Activity ID 10 and 11, have the formula/code automatically number the new row 801.

Thank you in advance.

 

[Artik]

In the module of this sheet (e.g. Sheet1), and NOT in the standard module (e.g. Module1), paste the following event procedure:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.ListObject.ListColumns(1).DataBodyRange) Is Nothing Then
        Application.EnableEvents = False
        With Target.ListObject.ListColumns(1).DataBodyRange
            .Cells(1).Value = 1
            .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
                Step:=1, Stop:=.Cells.Count, Trend:=False
        End With
        Application.EnableEvents = True
    End If
End Sub

Artik

 

[Alex Blakenburg]

As a formula you could try something like this:

=ROW()-ROW(Table4[[#Headers],[Activity ID]])

 

[Cubist]

Another option as long as the Activity column is unique.

Book1
	A	B	C
1		ID	Activity
2		1	A
3		2	B
4		3	C
5		4	D
6		5	J
7		6	H
8		7	E
9		8	F
Sheet8

Cell Formulas
Range	Formula
B2:B9	B2	=MATCH([@Activity],[Activity],0)

 

[FireBott]

VBA C

In the module of this sheet (e.g. Sheet1), and NOT in the standard module (e.g. Module1), paste the following event procedure:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.ListObject.ListColumns(1).DataBodyRange) Is Nothing Then
        Application.EnableEvents = False
        With Target.ListObject.ListColumns(1).DataBodyRange
            .Cells(1).Value = 1
            .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
                Step:=1, Stop:=.Cells.Count, Trend:=False
        End With
        Application.EnableEvents = True
    End If
End Sub

Artik

 

[FireBott]

Hi Artik,
Thank you for this code. However, when I copy it I get an error. Any ideas?

 

[Artik]

It seems that problems arose when copying the code. Remove the empty line between .DataSeries (...) and Step:=1, (...).
Also remove the [/code] tag in the End Sub line.

Artik

 

[FireBott]

It seems that problems arose when copying the code. Remove the empty line between .DataSeries (...) and Step:=1, (...).
Also remove the [/code] tag in the End Sub line.

Artik

Thank you. That was the solution. Have a great week.