Excel VBA: Addition of an extra row only on the table, not in the whole sheet

Question

I have been trying to modify my VBA code in order to add an extra row only on the specified table and not on the whole sheet. I have tried a few different options, checked with ChatGPT as well but nada.

Some key points:

I want to have a flexible code so i can use it in different templates; meaning:

• the table name will differ in each template (however, there will be a common star word: Table)
• the table column numbers are unlikely to change, but in case it ever does, i want that to be flexible too. Hence, I wanted to use a generic "tbl" variable as there will always be one table in all the sheets i will use this code on.

Here below is my code:

Sub AddRowToTable()

Dim tbl As ListObject 'Needed to reference a table '
Dim selectedCell As Range
   
On Error Resume Next
                    'Temporarily ignore the error that might occur during exec.'
                    'e.g., user clicks Cancel / ESC'
                    
Set selectedCell = Application.InputBox("Select a cell in the table below:", Type:=8)
    'Prompt the user to select a cell'
    
On Error GoTo 0

Set tbl = selectedCell.Worksheet.ListObjects(1) 'Assumes that there is only one table in the active sheet'

If Not tbl Is Nothing And Not selectedCell Is Nothing Then 'Check if the selection is within the table'
    
    If Not Intersect(selectedCell, tbl.DataBodyRange) Is Nothing Then
    
        selectedCell.Offset(1, 0).EntireRow.Insert
             'Insert a row below the selected cell within the table'
    Else
        MsgBox "Please select a cell within the table below."
    End If
Else
    MsgBox "No table found in the active sheet. Contact template owner."
End If
End Sub

Answer 1

Please try

Application.Intersect(selectedCell.EntireRow, tbl.Range).Insert

OR

tbl.ListRows.Add selectedCell.Row - tbl.DataBodyRange.Row + 1

Microsoft documentation:

ListRows.Add method (Excel)

ListObject.DataBodyRange property (Excel)

Answer 2

Insert Row Below Selected Cell in Excel Table

• It will ask the user to select a cell in the first Excel table of the active sheet to insert a row below it.

Sub InsertRowInTable()
 
    ' Define constants.
    Const PROC_TITLE As String = "Insert Row Below Selected Cell in Excel Table"
    Const TABLE_INDEX As Long = 1
    
    ' Reference the worksheet ('ws').
    
    Dim sh As Object: Set sh = ActiveSheet
    
    If sh Is Nothing Then
        MsgBox "No visible workbooks open!", vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    If Not TypeOf sh Is Worksheet Then
        MsgBox "Sheet """ & sh.Name & """ is not a worksheet!", _
            vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    ' Reference the table ('lo') and its range without totals ('lrg').
    
    If ws.ListObjects.Count < TABLE_INDEX Then
        MsgBox "Not enough tables found in worksheet """ & ws.Name & """!", _
            vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    Dim lo As ListObject: Set lo = ws.ListObjects(TABLE_INDEX)
    
    Dim lrg As Range, loName As String
    
    With lo
        Set lrg = .Range
        If Not .TotalsRowRange Is Nothing Then ' exclude totals row
            Set lrg = lrg.Resize(lrg.Rows.Count - 1)
        End If
        loName = .Name
    End With
    
    ' Build the input box parameters (strings).
    
    Dim iPrompt As String:
    iPrompt = "Select a cell in table """ & loName & """:"
    
    Dim acell As Range: Set acell = Intersect(ActiveCell, lrg)
    
    Dim iDefault As String:
    If Not acell Is Nothing Then iDefault = acell.Address
    
    ' User Input
    
    Dim cell As Range
    
    Do
        On Error Resume Next
            Set cell = Application _
                .InputBox(iPrompt, PROC_TITLE, iDefault, , , , , 8)
        On Error GoTo 0
        If cell Is Nothing Then
            MsgBox "Canceled.", vbExclamation, PROC_TITLE
            Exit Sub
        End If
    Loop While Intersect(cell.Cells(1), lrg) Is Nothing
    
    ' Add the first row in an empty table.
    If lo.ListRows.Count = 0 Then
        lo.ListRows.Add
        MsgBox "Added the first row in table """ & loName & """.", _
            vbInformation, PROC_TITLE
        Exit Sub
    End If
    
    ' Insert row below the selected cell in the table.
    Dim InsertRow As Long: InsertRow = cell.Row - lrg.Row + 1
    lo.ListRows.Add InsertRow
    
    ' Inform.
    MsgBox "Inserted data row " & InsertRow & " in table """ & loName & """.", _
        vbInformation, PROC_TITLE

End Sub