I deleted my previous reply. The VBA code in this post is an extensively edited version of my previous reply so please discard the earlier reply and refer to this one.
I believe that the formula provided by Hans V to create the unique Id's will result in the Id's being set relative to
the row number and will not remain with the original records when the table is sorted as per your comment
"the whole table needs to be sorted newest to oldest"
I would use the following formula in cell S3 (In the "Add New Data" field) and then it will increment each time a record is copied to the
table. The records are inserted in the table as values (not formulas) and therefore the Id number will remain with its appropriate record when the table is sorted.
(Edit Table1 in the formula to your table name and also ID if you should alter your column header.)
=MAX(Table1[ID])+1
The following code adds the new records to the table and then sorts Newest to Oldest on the date column. It then clears the contents from
the "Add New Data" section. You will also see that there is a test line of code to ensure that the user has entered data in at least one cell in addition to the Id number before it will copy the data to the table. Because the new data is cleared after copying,
the user should not be able to inadvertently copy the same record to the table multiple times.
You might like to think about using worksheet protection to prevent the formula in cell S3 being inadvertently over written by a user. If
you want to do this then see the commented out lines of code for Unprotect and Protect. A
table cannot resize on a protected sheet even if the entire table plus all rows below are unlocked and hence the Protect and Unprotect in the
VBA code if you want to use protection.
'Insert the following line at the top of a standard module before any subs.
Public Const strPassword = "ossie" Edit "ossie" to your password
Sub AddRow()
Dim ws As Worksheet
Dim lstObj As ListObject
Dim rngNew As Range
Set ws = Worksheets("Sheet1") 'Edit "Sheet1" to your sheet name
Set lstObj = ws.ListObjects("Table1") 'Edit "Table1" to you table name
'Test if the Row to enter data has been populated with the Id plus at least one other field
If WorksheetFunction.CountA(ws.Range("S3:X3")) < 2 Then
MsgBox "Cell S3 plus at least one cell in range T3:X3 must be populated." & vbCrLf & _
"Procesing terminated."
Exit Sub
End If
'ws.Unprotect Password:=strPassword 'Optional if protection used for cell S3
With lstObj.DataBodyRange
Set rngNew = .Cells(.Rows.Count + 1, 1).Resize(1, .Columns.Count)
rngNew.Value = ws.Range("S3:X3").Value
End With
With lstObj.Sort
.SortFields.Clear
.SortFields.Add Key:=lstObj.ListColumns("Date").DataBodyRange, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ws.Range("T3:X3").ClearContents 'Prevent saving multiple copies of same record
'ws.Cells(3, "S").Locked = True 'Optional if protection used for cell S3
'ws.Protect Password:=strPassword 'Optional if protection used for cell S3
End Sub