Macro to "Add line" identical but below - relative to button location - Excel 2010

[Marilu]

I have a simple table to calculate income for a customer.
I need to be able to add a button next to each line that adds another row below the button location, where it copies and pastes everything, enters 0 in amount cell, clears Source content and leave cursor in Source.
I've searched everywhere for a macro for relative references from with buttons with no luck. :/
Button can be either a shape, form or active, I dont care as long as it works!

similarily, I need to create a delete row button, to delete the row where the button is placed (including the button)

Table:

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Income Type
[/TD]
[TD]Source
[/TD]
[TD]Amount
[/TD]
[/TR]
[TR]
[TD]Salary or wages
[/TD]
[TD]<dropdown></dropdown>
[/TD]
[TD]$
[/TD]
[/TR]
[TR]
[TD]Bonus
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Pension
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Unemployment
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Alimony Child Supp
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]TOTAL
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Jerry Sullivan]

Hi and Welcome to MrExcel,

You say that you have a "simple table". Is that just a worksheet range or an actual Excel Table?

Here's some code that should work assuming that this is just a worksheet range. It could be modified to work with Excel Tables.

To setup, use Form Control buttons (not ActiveX buttons) and ensure that each button fits within one row.
Assign the Subs AddRow and DeleteRow to the respective buttons.

Test on a copy of your workbook, because you won't be able to undo changes.

Sub AddRow()
  Call CopyInsertThisRow(sBtnName:=Application.Caller)
End Sub

Sub DeleteRow()
  Call DeleteThisRow(sBtnName:=Application.Caller)
End Sub

Sub CopyInsertThisRow(ByVal sBtnName As String)
'--copies the row that has a button with this name
'  on the ActiveSheet
'  then insert-pastes into the row below the button
 Dim shp As Shape
 
 With ActiveSheet
   On Error Resume Next
   Set shp = .Shapes(sBtnName)
   On Error GoTo 0
   If shp Is Nothing Then
      MsgBox "Shape: " & sBtnName & " not found."
   Else
      With shp.TopLeftCell.EntireRow
         .Copy
         .Offset(1).Insert Shift:=xlDown
      End With
   End If
 End With
End Sub

Sub DeleteThisRow(ByVal sBtnName As String)
'--deletes the row that has a button with this name
'  on the ActiveSheet
 Dim shp As Shape
 
 With ActiveSheet
   On Error Resume Next
   Set shp = .Shapes(sBtnName)
   On Error GoTo 0
   If shp Is Nothing Then
      MsgBox "Shape: " & sBtnName & " not found."
   Else
      shp.TopLeftCell.EntireRow.Delete
   End If
 End With
End Sub

This code assumes that no two buttons on the same worksheet share the same button name. That's normally the case if the button names are generated by Excel; however it's possible to rename buttons to have the same name.

 

[Marilu]

I can't simply thank you enough for taking the time to respond to my question and provide the solution, and in such a quick turnaround. The code above works to add a new row and copy paste the values.
No wonder I couldn't figure this out, it is way more complex than what I expected (given my minimal vba understanding).
If I may bug you with some more questions on this solution:
- During the same InsertRow action, How would I assign the amount value of the new row to 0 (so that amount is blank), clear the value in the Source column and leave the cursor there?
- The deletethisRow macro works but doesn't delete the button. How can it be deleted?

Many thanks!

(Btw, by table I was referring to values in a regular worksheet)

 

[Jerry Sullivan]

Glad to hear that helped.

Replace the previous CopyInsertThisRow procedure with this one to do the extra steps you described.

Sub CopyInsertThisRow(ByVal sBtnName As String)
'--copies the row that has a button with this name
'  on the ActiveSheet
'  then insert-pastes into the row below the button
 Dim shp As Shape
 
 With ActiveSheet
   On Error Resume Next
   Set shp = .Shapes(sBtnName)
   On Error GoTo 0
   If shp Is Nothing Then
      MsgBox "Shape: " & sBtnName & " not found."
   Else
      With shp.TopLeftCell.EntireRow
         .Copy
         .Offset(1).Insert Shift:=xlDown
         '--set amount to $0
         .Cells(2, "C").Value = 0
         '--clear source field
         .Cells(2, "B").ClearContents
         .Cells(2, "B").Select
       End With
   End If
 End With
End Sub

If you set the properties of your buttons like this, they should be deleted when the row is deleted.

Right-Click the Button > Format control... > Properties > choose option "Move and size with cells"

 

[Marilu]

It works perfectly. Thanks!