Macro to add rows based on cell value- multiple tabs

[Ashley1432]

I am creating customer collections letters and need to be able to add rows of data into the letter based on how many past due invoices the customer has. Each customer has its own tab, and the number of past due invoices is in cell B3 on each tab. I need a macro that will go to each tab and add X many rows (starting at row 8) based on the value in B3 on that specific tab. I'm horrible at macros and try to avoid them but I can't think of a way to do this otherwise. Please help! I will also need it to copy the equations down from row 7 if you want to help with that too

	A	B	C
1	Cust:A111	3
2
3
4	Dr. Mr. Smith,
5	The following invoices are now past due.
6
7	#	Document #	Amt
8	1	123456	71.00
9

<tbody>
</tbody>

 

[MrKowz]

Welcome to the forums!

Give this code a shot - be sure to back up your file before running:

Public Sub InsertRows()
Dim ws      As Worksheet
Dim insRow  As Long
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
    insRow = ws.Range("B1").Value
    ws.Range("A8").Resize(insRow, 1).EntireRow.Insert shift:=xlDown
Next ws
Application.ScreenUpdating = True
End Sub

As for the part about copying formulas, what cell(s) hold the formulas and where should they be copied to?

 

[Ashley1432]

This seems to be working, except I do get an error that says Run Time error 1004, Application defined ot object defined error. The line that highlights when I debug is ws.Range("A8").Resize(insRow, 1).EntireRow.Insert shift:=xlDown.

About the copying of the formulas- I have formulas in A7:C7 that i would want copied down into the newly created rows to populate the list of invoices that are past due.

Thanks so much for your help!

 

[MrKowz]

This seems to be working, except I do get an error that says Run Time error 1004, Application defined ot object defined error. The line that highlights when I debug is ws.Range("A8").Resize(insRow, 1).EntireRow.Insert shift:=xlDown.

About the copying of the formulas- I have formulas in A7:C7 that i would want copied down into the newly created rows to populate the list of invoices that are past due.

Thanks so much for your help!

The below code works for me on dummy data.

Public Sub InsertRows()
Dim ws      As Worksheet
Dim insRow  As Long
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
    insRow = ws.Range("B1").Value
    ws.Range("A8").Resize(insRow, 1).EntireRow.Insert shift:=xlDown
    ws.Range("A7:C7").Copy Destination:=ws.Range("A8").Resize(insRow, 3)
Next ws
Application.ScreenUpdating = True
End Sub

If you get that error again, I wonder if it is coming across a worksheet which does not have a value in B1, and ergo is trying to resize the range to an invalid dimension. Hover over insRow in the yellow-highlighted line if you get the error again and let me know what value it is returning.

 

[Ashley1432]

I see whats happening, one of the tabs has 0 in B1 and so its stopping, not know what to do. When i hover over the insRow it says insRow=0. Other than that it is working beautifully!

 

[MrKowz]

The below code will check to see if the value is greater than 0. If it is, then it will execute the code. If it is not, it will go to the next worksheet.

Public Sub InsertRows()
Dim ws      As Worksheet
Dim insRow  As Long
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
    insRow = ws.Range("B1").Value
    If insRow > 0 Then
        ws.Range("A8").Resize(insRow, 1).EntireRow.Insert shift:=xlDown
        ws.Range("A7:C7").Copy Destination:=ws.Range("A8").Resize(insRow, 3)
    End If
Next ws
Application.ScreenUpdating = True
End Sub

 

[Ashley1432]

This worked beautifully! Thanks so much for your help, i never would have been able to do this on my own.