Vba add row excel vba

Miguel TeixeiraMiguel Teixeira

7731 gold badge10 silver badges29 bronze badges

You don’t say which version of Excel you are using. This is written for 2007/2010 (a different apprach is required for Excel 2003 )

You also don’t say how you are calling addDataToTable and what you are passing into arrData.
I’m guessing you are passing a 0 based array. If this is the case (and the Table starts in Column A) then iCount will count from 0 and .Cells(lLastRow + 1, iCount) will try to reference column 0 which is invalid.

You are also not taking advantage of the ListObject. Your code assumes the ListObject1 is located starting at row 1. If this is not the case your code will place the data in the wrong row.

Here’s an alternative that utilised the ListObject

Sub MyAdd(ByVal strTableName As String, ByRef arrData As Variant)
    Dim Tbl As ListObject
    Dim NewRow As ListRow

    ' Based on OP 
    ' Set Tbl = Worksheets(4).ListObjects(strTableName)
    ' Or better, get list on any sheet in workbook
    Set Tbl = Range(strTableName).ListObject
    Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)

    ' Handle Arrays and Ranges
    If TypeName(arrData) = "Range" Then
        NewRow.Range = arrData.Value
    Else
        NewRow.Range = arrData
    End If
End Sub

Can be called in a variety of ways:

Sub zx()
    ' Pass a variant array copied from a range
    MyAdd "MyTable", [G1:J1].Value
    ' Pass a range
    MyAdd "MyTable", [G1:J1]
    ' Pass an array
    MyAdd "MyTable", Array(1, 2, 3, 4)
End Sub

answered Sep 6, 2012 at 11:06

Tbl.ListRows.Add doesn’t work for me and I believe lot others are facing the same problem. I use the following workaround:

    '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
                lastRow.Cells(1, col).EntireRow.Insert
                'Cut last row and paste to second last
                lastRow.Cut Destination:=table.ListRows(table.ListRows.count - 1).Range
                Exit For
            End If
        Next col
    End If

    'Populate last row with the form data
    Set lastRow = table.ListRows(table.ListRows.count).Range
    Range("E7:E10").Copy
    lastRow.PasteSpecial Transpose:=True
    Range("E7").Select
    Application.CutCopyMode = False

Hope it helps someone out there.

answered Mar 25, 2013 at 10:22

I had the same error message and after lots of trial and error found out that it was caused by an advanced filter which was set on the ListObject.
After clearing the advanced filter .listrows.add worked fine again.
To clear the filter I use this — no idea how one could clear the filter only for the specific listobject instead of the complete worksheet.

Worksheets("mysheet").ShowAllData

answered Dec 4, 2014 at 17:18

answered Jun 25, 2017 at 20:13

answered Sep 4, 2018 at 12:35

As using ListRow.Add can be a huge bottle neck, we should only use it if it can’t be avoided.
If performance is important to you, use this function here to resize the table, which is quite faster than adding rows the recommended way.

Be aware that this will overwrite data below your table if there is any!

This function is based on the accepted answer of Chris Neilsen

Public Sub AddRowToTable(ByRef tableName As String, ByRef data As Variant)
    Dim tableLO As ListObject
    Dim tableRange As Range
    Dim newRow As Range

    Set tableLO = Range(tableName).ListObject
    tableLO.AutoFilter.ShowAllData

    If (tableLO.ListRows.Count = 0) Then
        Set newRow = tableLO.ListRows.Add(AlwaysInsert:=True).Range
    Else
        Set tableRange = tableLO.Range
        tableLO.Resize tableRange.Resize(tableRange.Rows.Count + 1, tableRange.Columns.Count)
        Set newRow = tableLO.ListRows(tableLO.ListRows.Count).Range
    End If

    If TypeName(data) = "Range" Then
        newRow = data.Value
    Else
        newRow = data
    End If
End Sub

answered Apr 25, 2017 at 23:41

Bhanu SinhaBhanu Sinha

1,51612 silver badges10 bronze badges