VBA Insert ROWs into table and continue index value based on last row

[JILBO]

Hi,

I have some VBA i utilise to Add 10 Rows to the bottom of a table [ChgTBL].

The Table has an Index counter currently using a =ROW() function, however when through another method rows are deleted it gives a 'REF! error in the index column.

Is there another method that could be employed which would populate the Index and countinue numbering based and the last cells value +1?

Thanks




Public Sub AddRow()

'
' Code for ADD RECORD Button in Ribbon


'Unprotect Sheet so new Row can be added


ActiveSheet.Unprotect


Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Application.ScreenUpdating = False
Set tbl = ws.ListObjects("ChgTBL")
Dim i As Byte






'Adds 10 rows to end of Table
For i = 1 To 10
'add a row at the end of the table


tbl.ListRows.Add AlwaysInsert:=True


Next i


' Range("ChgTBL[#All]").Select
' Selection.RowHeight = 31


'Protect Sheet after adding rows, Set the access of the locked cells if required.


'ActiveSheet.Protect


Range("ChgTBL[Serial]").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
True, AllowFiltering:=True, AllowDeletingRows:=True, AllowSorting:=True _
, AllowUsingPivotTables:=True, AllowFormattingCells:=True


Application.ScreenUpdating = True








End Sub

[JILBO]

Any ideas whether this can be done? Shall i supply a sample workbook?

[JILBO]

Figured it out now and works a treats

code below


'VBA Add Multiple Rows to TableSub AddRow()

'Declare Variables
Dim oSheetName As Worksheet
Dim sTableName As String
Dim loTable As ListObject
Dim iCnt As Integer
Dim lrRow As ListRow

'Define Variable
sTableName = "ChgTBL"

'Define WorkSheet object
Set oSheetName = Sheets("Register")

'Define Table Object
Set loTable = oSheetName.ListObjects(sTableName)

'ActiveSheet.Unprotect ' Password:="CHANGE"
'Application.ScreenUpdating = False

For iCnt = 1 To 5 'You can change based on your requirement
'Add multiple rows to the table
Set lrRow = loTable.ListRows.Add

With lrRow
'Increments last value + 1 for the Serial
.Range(2) = .Range(2).Offset(-1).Value + 1
.Range(3) = Date + Time
.Range(4) = Application.UserName
End With

Next

' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
' True, AllowFiltering:=True, AllowDeletingRows:=True, AllowSorting:=True _
' , AllowUsingPivotTables:=True, AllowFormattingCells:=True


Application.ScreenUpdating = True

End Sub