Function or sub to add a new row and data to the table

Question

I want to create a Sub, which basically allows me to orient an Excel spreadsheet with a specific name, and then insert a new row at the bottom and at the same time add data to that row. Then exit from under. And if the table has only one row without data, add data to this row, and then exit from under.

How can i do this?

I thought something like this, in pseudocode:

Public Sub addDataToTable(ByVal strTableName as string, ByVal strData as string, ByVal col as integer) ActiveSheet.Table(strTableName).Select If strTableName.Rows.Count = 1 Then strTableName(row, col).Value = strData Else strTable(lastRow, col).Value = strData End if End Sub 

This is probably not valid as code in general, but it should explain what I need at least!

Answer 1

Is this what you are looking for?

 Option Explicit Public Sub addDataToTable(ByVal strTableName As String, ByVal strData As String, ByVal col As Integer) Dim lLastRow As Long Dim iHeader As Integer With ActiveSheet.ListObjects(strTableName) 'find the last row of the list lLastRow = ActiveSheet.ListObjects(strTableName).ListRows.Count 'shift from an extra row if list has header If .Sort.Header = xlYes Then iHeader = 1 Else iHeader = 0 End If End With 'add the data a row after the end of the list ActiveSheet.Cells(lLastRow + 1 + iHeader, col).Value = strData End Sub 

It handles both cases whether you have a header or not.

Answer 2

I needed the same solution, but if you use your own ListObject.Add() method, you avoid the risk of colliding with any data right below the table. The procedure below checks the last row of the table and adds data there if it is empty; otherwise, it adds a new row to the end of the table:

 Sub AddDataRow(tableName As String, values() As Variant) Dim sheet As Worksheet Dim table As ListObject Dim col As Integer Dim lastRow As Range Set sheet = ActiveWorkbook.Worksheets("Sheet1") Set table = sheet.ListObjects.Item(tableName) 'First check if the last row is empty; if not, add a row If table.ListRows.Count > 0 Then Set lastRow = table.ListRows(table.ListRows.Count).Range For col = 1 To lastRow.Columns.Count If Trim(CStr(lastRow.Cells(1, col).Value)) <> "" Then table.ListRows.Add Exit For End If Next col Else table.ListRows.Add End If 'Iterate through the last row and populate it with the entries from values() Set lastRow = table.ListRows(table.ListRows.Count).Range For col = 1 To lastRow.Columns.Count If col <= UBound(values) + 1 Then lastRow.Cells(1, col) = values(col - 1) Next col End Sub 

To call the function, pass the table name and an array of values, one for each column. You can get / set the table name from the Design tab on the ribbon, at least in Excel 2013:

Sample code for a table with three columns:

 Dim x(2) x(0) = 1 x(1) = "apple" x(2) = 2 AddDataRow "Table1", x 

Answer 3

Minor change in Jeff's answer.

New data in the array:

 Sub AddDataRow(tableName As String, NewData As Variant) Dim sheet As Worksheet Dim table As ListObject Dim col As Integer Dim lastRow As Range Set sheet = Range(tableName).Parent Set table = sheet.ListObjects.Item(tableName) 'First check if the last row is empty; if not, add a row If table.ListRows.Count > 0 Then Set lastRow = table.ListRows(table.ListRows.Count).Range If Application.CountBlank(lastRow) < lastRow.Columns.Count Then table.ListRows.Add End If End If 'Iterate through the last row and populate it with the entries from values() Set lastRow = table.ListRows(table.ListRows.Count).Range For col = 1 To lastRow.Columns.Count If col <= UBound(NewData) + 1 Then lastRow.Cells(1, col) = NewData(col - 1) Next col End Sub 

New data in the horizontal range:

 Sub AddDataRow(tableName As String, NewData As Range) Dim sheet As Worksheet Dim table As ListObject Dim col As Integer Dim lastRow As Range Set sheet = Range(tableName).Parent Set table = sheet.ListObjects.Item(tableName) 'First check if the last table row is empty; if not, add a row If table.ListRows.Count > 0 Then Set lastRow = table.ListRows(table.ListRows.Count).Range If Application.CountBlank(lastRow) < lastRow.Columns.Count Then table.ListRows.Add End If End If 'Copy NewData to new table record Set lastRow = table.ListRows(table.ListRows.Count).Range lastRow.Value = NewData.Value End Sub 

Answer 4

A minor change to the phillfri response, which was already a variation of Jeff's answer: I added the ability to handle completely empty tables that do not contain data for the array code.

 Sub AddDataRow(tableName As String, NewData As Variant) Dim sheet As Worksheet Dim table As ListObject Dim col As Integer Dim lastRow As Range Set sheet = Range(tableName).Parent Set table = sheet.ListObjects.Item(tableName) 'First check if the last row is empty; if not, add a row If table.ListRows.Count > 0 Then Set lastRow = table.ListRows(table.ListRows.Count).Range If Application.CountBlank(lastRow) < lastRow.Columns.Count Then table.ListRows.Add End If End If 'Iterate through the last row and populate it with the entries from values() If table.ListRows.Count = 0 Then 'If table is totally empty, set lastRow as first entry table.ListRows.Add Position:=1 Set lastRow = table.ListRows(1).Range Else Set lastRow = table.ListRows(table.ListRows.Count).Range End If For col = 1 To lastRow.Columns.Count If col <= UBound(NewData) + 1 Then lastRow.Cells(1, col) = NewData(col - 1) Next col End Sub