VBA - Command Button, Add Row To Table, When Cell is Selected In Table

[teksp0rt]

Hello Experts. Thanks for your help.

I have a worksheet with 3 tables on it. Each table is named,Floor1, Floor2, Floor3. What I am trying to accomplish is write VBA code, whereI press a command button, and the table that I am working in (cell was lastselected) will have a new row created at the end.

Below is the code that I am using for each table - as Icurrently have one command button for each table. My ideas is to simply thisprocess as the tables can be rather long and the command buttons are moving allover the place when I add new rows.


Sub AddFloor1Row()


Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Floor1")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add
With newrow
.Range(1) = 0
.Range(2) = "x"
.Range(3) = 0
.Range(5) = "=[@Column1]*[@Column3]"
.Range(6) = 0
.Range(7) = "=[@Column5]*[@Column6]"
.Range(8) = 0
.Range(9) = "=iferror([@Column8]/[@Column5],0)"
.Range(10) = "=iferror([@Column9]*[@Column7],0)"
.Range(11) ="=iferror([@Column7]/Floor1[[#Totals],[Column7]],0)"
.Range(12) = "=iferror([@Column7]/$F$7,0)"

End With


<!--[if !supportLineBreakNewLine]-->
<!--[endif]-->

 

[Logit]

.
This will add a row, below the cell that is active :

Option Explicit


Sub AddRow()
    Dim ws As Worksheet
    Dim rng As Range


    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")        '<-- NOTE: Insert Sheet name here.


    With ws
        '~~> Set your range
        Set rng = .Rows(ActiveCell.Row)


        '~~> Copy the range
        'rng.Copy                               '<--  NOTE: Copies content of row the cursor is in and pastes to the new row


        '~~> Insert the range
        rng.Offset(0).Insert Shift:=xlUp        '<--  NOTE: Change Offset to (1) & xlDown for new row down.
                                                '<--  Note: Change Offset to (0) & xlUp for new row up.
        '~~> Clear the clipboard. More importantly remove the
        '~~> ant like borders
        Application.CutCopyMode = False
    End With
End Sub

 

[teksp0rt]

Thanks Logit. You gave me an idea... Setting table to Active Cell. I needed to create another variable.
Below is my code. No comments but it works.

Sub AddTableRow()


Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Dim activeTable As String


activeTable = ActiveCell.ListObject.Name


Set tbl = ws.ListObjects(activeTable)
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add


End Sub

 

[teksp0rt]

is there better code than this?