Add Unique ID to new Row, which is +1 of the current Max ID, using Macro

Hi,

I have a spreadsheet with a Macro which identifies the Active Cell and inserts a new Row in that location. Column A of the Table is for the ID number.

I want the same Macro to self populate an ID in Column A of the new Row. I need it to be +1 higher than the maximum ID number already present in that column. In case it matters, Column A is using a Special Format (000) to ensure it always contains three digits. For example the number 3 will be shown as 003. Not sure if this matters.

As Rows will not always be at the bottom of the Table I cannot do a simple increment of the line above.

And this is where i am stuck as I am not very good at VBA. Any help would be appreciated.

Here it the current code.

Sub InsertARow()
Dim r As Long
On Error GoTo ErrHandler
' Get the row number
r = ActiveCell.Row
' Unprotect the sheet
ActiveSheet.Unprotect Password:="123"
' Insert a row
Range("N" & r).EntireRow.Insert
' Fill down the formula from above the inserted row to below it
Range("N" & (r - 1) & ":N" & (r + 1)).FillDown

ExitHandler:
' Protect the sheet again
ActiveSheet.Protect Password:="123"
' Get out
Exit Sub

ErrHandler:
' Report the error to the user
MsgBox Err.Description, vbExclamation
' Always go past the exit handler section
Resume ExitHandler
End Sub

Hi, thanks very much. I think I inserted it correctly below. I have reset the A column to be Number format for now. Unfortunately when I run it I get the new row, but followed by an error alert saying Overflow.

(Also, how does everyone paste their code in such a presentable manner, when I paste below it looks really messy lol)

Sub InsertARow()
Dim r As Long
On Error GoTo ErrHandler
' Get the row number
r = ActiveCell.Row
' Unprotect the sheet
ActiveSheet.Unprotect Password:="123"
' Insert a row
Range("N" & r).EntireRow.Insert
' Fill down the formula from above the inserted row to below it
Range("N" & (r - 1) & ":N" & (r + 1)).FillDown

'Insert ID - Assuming column A is number and not text
Dim MaxID As Integer
MaxID = Application.WorksheetFunction.Max(Range("A:A"))
ActiveCell.NumberFormat = "000"
ActiveCell = MaxID + 1

ExitHandler:
' Protect the sheet again
ActiveSheet.Protect Password:="123"
' Get out
Exit Sub

ErrHandler:
' Report the error to the user
MsgBox Err.Description, vbExclamation
' Always go past the exit handler section
Resume ExitHandler
End Sub

Thank you for your help. Thought I would close this as I finally have it working.

Sub InsertARow()
Dim AR As Long
Dim MaxID As Long
Dim NewID As Long
Dim Tracker As Worksheet
Dim IDColumn As Range


Set Tracker = ThisWorkbook.Sheets("Tracker")
Set IDColumn = Range(Cells(14, 1), Cells(110, 1))


MaxID = Application.WorksheetFunction.Max(IDColumn)
NewID = MaxID + 1
AR = ActiveCell.Row


On Error GoTo ErrHandler
' Unprotect the sheet
    Tracker.Unprotect Password:="123"
' Insert a row
    Range("N" & AR).EntireRow.Insert
' Fill down the formula from above the inserted row to below it
    Range("N" & (AR - 1) & ":N" & (AR + 1)).FillDown
' Select ID cell for new row
    Cells(ActiveCell.Row, 1).Select
' Format ID Column
    ActiveCell.NumberFormat = "000"
' insert new ID number
    ActiveCell.Value = NewID
    
ExitHandler:
' Protect the sheet again
    Tracker.Protect Password:="123"
' Get out
    Exit Sub


ErrHandler:
    ' Report the error to the user
    MsgBox Err.Description, vbExclamation
    ' Always go past the exit handler section
    Resume ExitHandler
End Sub