Add 2 rows with data using a macro button

Question

Hello,

Hoping someone could help with adding a macro code to a button.

I'm looking to add a button to a form where I can "add new supplier" which then adds 2 rows with already input data:

So what I have is a section which has:

A2 & C2 'Vendor ID & Name'

A3 & C3 'Contract End Date & Contract Start date'

Current Supplier:	New Supplier:
Vendor ID & Name:		Vendor ID & Name:
Contract End Date:		Contract Start Date:

I basically want to insert a button that when clicked will repeat these 2 rows with the data and blank cells as many times as clicked.

So if i have 5 suppliers I can click 5 times and get 10 rows with the above format

Any help would be much appreciated.

Answer 1

Is there a way so that it populates in a specific row (so as not having to select a cell in a row before hand) and then always pushes down any data beneath it?

When i try and select 3 or 4 in ("How many times do you want to insert 2 rows?") - it knocks the data below out of place. Is there a way to avoid this or would it have to be done one by one?

Thank you for your help,

Answer 2

Great - this worked for me. Thank you

Answer 3

Select any cell in the row under which you want to insert 2 rows and run the macro below. Example: if you want to insert 5 x 2 rows below row 3 with the text you posted above: select first any cell in row 3 and run the macro. Then, select any cell in row 5 and run the macro again; then: select any cell in row 7 and run the macro again; and so on...

Sub Insert_rows()
Dim r as integer

r = ActiveCell.Row 

ActiveCell.Offset(1).EntireRow.Resize(2).Insert 

Cells(r + 1, 1) = "Vendor id & Name:" 

Cells(r + 2, 1) = "Contract End Date" 

With Range(Cells(r + 1, 1), Cells(r + 2, 2)) 

.HorizontalAlignment = xlGeneral 

.Borders.LineStyle = xlContinuous 

End With 

Range(Cells(r + 1, 1), Cells(r + 2, 2)).Copy Cells(r + 1, 3) 

Columns("A:D").AutoFit 

End Sub

---

The macro below allows you to insert the desired number of rows (x2) with your text with 1 click. Same method as in my first macro: select any cell in the row under which you want to insert rows, and then run the macro.

Sub insert_rows2() 

Dim r As Integer, x As Integer, y As Integer 

r = ActiveCell.Row 

x = InputBox("How many times do you want to insert 2 rows ?") 

If x < 1 Then Exit Sub 

ActiveCell.Offset(1).EntireRow.Resize(2).Insert 

Cells(r + 1, 1) = "Vendor id & Name:" 

Cells(r + 2, 1) = "Contract End Date" 

With Range(Cells(r + 1, 1), Cells(r + 2, 2)) 

.HorizontalAlignment = xlGeneral 

.Borders.LineStyle = xlContinuous 

End With 

Range(Cells(r + 1, 1), Cells(r + 2, 2)).Copy Cells(r + 1, 3)
If x > 1 then 

For y = 1 To x - 1 

Range(Cells(r + 1, 1), Cells(r + 2, 4)).Copy Cells(r + 3, 1) 

r = r + 2 

Next y 
End If

End Sub

Answer 4

Hi Jeovany,

Thanks for the reply. I can get this to work on a new sheet. I just can't get it to work in my worksheet where I need it to add into row 34 and subsequently push down the data below to fit.

Is there a simple work around for this that I'm missing here?

Thank you

Answer 5

Hi Rodney

Please, try the following macro, based on your description.

Sub AddNewVendors()

Dim lrow As Long

With ActiveSheet

lrow = .Cells(Rows.Count, "A").End(xlUp).Row + 1 

.Cells(lrow, "A").Value = "Vendor ID & Name:"

.Cells(lrow, "C").Value = "Vendor ID & Name:"

.Cells(lrow + 1, "A").Value = "Contract End Date:"

.Cells(lrow + 1, "C").Value = "Contract Start Date:"

With .Cells(lrow, "A").Resize(2, 4).Borders 

    .LineStyle = xlContinuous 

    .Weight = xlThin 

End With 

End With

End Sub

You may download the sample file here, https://we.tl/t-ni4bR3lhP3

Do let me know if you need more help

Regards

Jeovany