![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Microsoft 365 and Office | Excel | For home | Windows
A family of Microsoft spreadsheet software with tools for analyzing, charting, and communicating data.
First of all, there is no need to use the Activate method in VBA, nor the Select. While you can, it certainly isn't necessary.
I could guess the ActiveSheet, at run-time, isn't the one which houses the Table by your variable name? If it does, it could be that a row either can't be inserted (no row could be consumed), or the sheet was protected. Your code, as posted, works for me.
Private Sub New_Item( _
ByVal strTable As String, _
ByVal strItem As String, _
ByVal strColName As String _
)
Dim ThisCol As Integer
Dim NextRow As Integer
Dim TopRow As Integer
Dim Tbl As ListObject
Dim NewRow As ListRow
Set Tbl = Worksheets("Factors").ListObjects(strTable)
Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
It will be hard to diagnose without more information, but my best guess is Excel can't insert a row. Perhaps there is something blocking the Table from expanding, most likely data below it, or a merge area which spans past the bounds of the Table [columns].
There are several issues with a Table which could go wrong when inserting row(s). On top of that, native functionality only allows for a single row insertion, and it always goes at the end. This led me to write my own function to insert rows, but also because I wanted to do more than a single row as well as specify the position. Here is what I use.
Function InsertRows( _
ByVal Table As ListObject, _
Optional ByVal Position As Long, _
Optional ByVal RowCount As Long = 1, _
Optional ByVal MessageOnError As Boolean = False _
) As Long
'
' Insert a specified number of blank rows into the Table in a given position.
'
Dim InsertRange As Range
Dim HeadersVisible As Boolean
If Table Is Nothing Then Exit Function
If RowCount < 1 Then Exit Function
If Position < 0 Then Exit Function
HeadersVisible = Table.ShowHeaders
' Show headers
On Error Resume Next
If HeadersVisible = False Then Table.ShowHeaders = True
On Error GoTo 0
If Table.ShowHeaders = False And HeadersVisible = False Then
If MessageOnError Then MsgBox "Something went wrong. The Table sheet might be protected or the Table can't be shifted.", vbExclamation, "Whoops!"
Exit Function
End If
' Take care of a simple, single row insert
If (RowCount = 1 And Position = 0) Or Table.DataBodyRange Is Nothing Then
Table.ListRows.Add
If RowCount = 1 And Position = 0 Then Exit Function
End If
' Normalize insert row position
If Position = 0 Then Position = Table.ListRows.Count + 1
' Find range to insert rows
On Error Resume Next
If Table.DataBodyRange Is Nothing Then
Set InsertRange = Table.InsertRowRange.Resize(RowCount)
Else
Set InsertRange = Table.DataBodyRange.Resize(RowCount).Offset(Position - 1)
End If
On Error GoTo 0
If InsertRange Is Nothing Then
If MessageOnError Then MsgBox "Something went wrong. Position could not be found.", vbExclamation, "Whoops!"
Exit Function
End If
' Perform insert
On Error Resume Next
If Intersect(InsertRange.EntireRow, Table.Range) Is Nothing Then
Table.Resize Table.Parent.Range(Table.Range.Address).Resize(Table.Range.Rows.Count + RowCount, Table.ListColumns.Count)
Else
InsertRange.Insert Shift:=xlDown
End If
On Error GoTo 0
If InsertRange Is Nothing Then
If MessageOnError Then MsgBox "Something went wrong. Rows could not be inserted.", vbExclamation, "Whoops!"
Exit Function
End If
' Set header visibility to what it was
If Not HeadersVisible Then Table.ShowHeaders = HeadersVisible
InsertRows = 1
End Function