Insert Row at Bottom of Table Maintain Formulas and Format Using VBA Button

[gplans]

I would like to know how you can use a macro to insert a row at the very bottom of your table and also maintain the formatting and formulas from the table.

I used this code but it does not copy the formatting or the formulas from the line above.

I use this technique from the link in this video.

https://www.youtube.com/watch?v=9JTLJ1XjOJc

Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.EntireRow.Insert

Any help Thanks

 

[Michael M]

Try

Sub MM1()
    With Rows(Cells(Rows.Count, "A").End(xlUp).Row)
         .Insert
         .Copy
        .Offset(-1).EntireRow.PasteSpecial Paste:=xlPasteFormats
        .Offset(-1).EntireRow.PasteSpecial Paste:=xlPasteFormulas
    End With
Application.CutCopyMode = False
End Sub

 

[gplans]

Try

Sub MM1()
    With Rows(Cells(Rows.Count, "A").End(xlUp).Row)
         .Insert
         .Copy
        .Offset(-1).EntireRow.PasteSpecial Paste:=xlPasteFormats
        .Offset(-1).EntireRow.PasteSpecial Paste:=xlPasteFormulas
    End With
Application.CutCopyMode = False
End Sub

Thanks Michael for the quick response.

It is very close but when it copies the format and formulas it copies the very bottom line that contains the sum amount. Also is it possible to have the OBS CHEOPS # add in sequence OBSM100034, OBSM100035, OBSM100036 when I add the new row.

I have attached the file via the link below.

https://filebin.net/xjxa2z8ekzn13roo

Image
https://filebin.net/q4bv2dh9hp2pjg7h

 

[Michael M]

Maybe this then

Sub MM2()
Dim myRow As Long
    myRow = Cells(Rows.Count, "A").End(xlUp).Row
    With Rows(myRow)
        .Copy
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
Range("A" & myRow + 1).Value = "OBSM" & Right(Range("A" & myRow).Value, 6) + 1
Application.CutCopyMode = False
End Sub

 

[gplans]

Maybe this then

Sub MM2()
Dim myRow As Long
    myRow = Cells(Rows.Count, "A").End(xlUp).Row
    With Rows(myRow)
        .Copy
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
Range("A" & myRow + 1).Value = "OBSM" & Right(Range("A" & myRow).Value, 6) + 1
Application.CutCopyMode = False
End Sub

I get a Run-Time error '1004'
Application-defined or object-defined error

Were you able to get it to work on the one I uploaded to https://filebin.net/xjxa2z8ekzn13roo

Thanks Again for looking.

 

[Michael M]

I don't download zip files !!
Someone else may jump in and download the file to give you assistance.
If it's an actual Excel table the code will have to be changed to reflect the name and list objects of the table.

 

[Norie]

If you want to add a row to a table you can use ListRows.Add.

Dim tblRow As ListRow

    Set tblRow = Sheets("OBS Main Data").ListObjects("Table5").ListRows.Add

    tblRow.Range.Offset(-1).Copy

    tblRow.Range.PasteSpecial xlPasteFormulasAndNumberFormats

    Application.CutCopyMode = False

 

[gplans]

If you want to add a row to a table you can use ListRows.Add.

Dim tblRow As ListRow

    Set tblRow = Sheets("OBS Main Data").ListObjects("Table5").ListRows.Add

    tblRow.Range.Offset(-1).Copy

    tblRow.Range.PasteSpecial xlPasteFormulasAndNumberFormats

    Application.CutCopyMode = False

No that still has not worked. It copes the very last line which has the sum total formulas in it. It should copy the second from the last row and insert it in the second from the last row. This means there will will always have a total at the bottom.


1. Format & Formulas
2. Format & Formulas
3. Format & Formulas
4. Totals

New line would go in between 3 & 4

Also it would be good when adding a new line the numbering would be added in sequential order. OBSM100034, OBSM100035, OBSM100036

Link to the spreadsheet that is not zipped:

https://www.dropbox.com/s/3zptvki2g5p91qr/MASTER SPREADSHEET.xlsm?dl=0

Thanks for your help.

 

[gplans]

Bump on this one

Thanks

 

[Michael M]

Maybe this then

Private Sub CommandButton1_Click()
Dim myRow As Long, tblRow As ListRow
    myRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set tblRow = Sheets("OBS Main Data").ListObjects("Table5").ListRows.Add(myRow - 2)
    tblRow.Range.Offset(-1).Copy
    tblRow.Range.PasteSpecial xlPasteFormulasAndNumberFormats
    Application.CutCopyMode = False
    With Range("A" & myRow)
        .Value = "OBSM" & Right(Range("A" & myRow).Value, 6) + 1
        .HorizontalAlignment = xlCenter
    End With
End Sub