Forum Discussion
Solved
Referencing issue when running insert-rows-Macro
Hello there, I am struggling in a situation I hope anyone could help or provide any workaround. I am attaching a sample document to make the situation more clear. I run Excel 365. I have two ...
Sub Add_Rows() Dim i As Long Dim n As Long Dim rng1 As Range Dim rng2 As Range Application.ScreenUpdating = False Sheets("Sheet1").Select n = Range("E2").Value ' Copy and insert row in first range Set rng1 = Cells.Find(What:="Header 1", LookAt:=xlWhole) For i = 1 To n rng1.Offset(RowOffset:=2).EntireRow.Copy rng1.Offset(RowOffset:=3).EntireRow.Insert Next i ' Copy and insert row in second range Set rng2 = Cells.Find(What:="Header 2", LookAt:=xlWhole) For i = 1 To n rng2.Offset(RowOffset:=2).EntireRow.Copy rng2.Offset(RowOffset:=3).EntireRow.Insert Next i ' Correct the formulas Range(rng1.Offset(RowOffset:=1), rng2.Offset(RowOffset:=-1)).FillDown Range(rng2.Offset(RowOffset:=1), rng2.End(xlDown)).FillDown Application.ScreenUpdating = True End Sub
Thank you for taking your time. I am afraid to say that I was not fortunate to provide an accurate representative sample document and I missed a couple of things.
a) Both ranges are not "separated" by empty rows.
b) There is a cell indicating how many rows are going to be inserted (did not include this in my sample code). Therefore, it can happen that, for instance, 3 rows are created. For this purpose, I use:
Sub Button_add_rows()
NumRows = Range("E2").Value
For i = 1 To NumRows
Call Add_Rows()
Next i
End Sub
Let me attach you the sample document again. Sorry for the confusion, my mistake.
Sub Add_Rows()
Dim i As Long
Dim n As Long
Dim rng1 As Range
Dim rng2 As Range
Application.ScreenUpdating = False
Sheets("Sheet1").Select
n = Range("E2").Value
' Copy and insert row in first range
Set rng1 = Cells.Find(What:="Header 1", LookAt:=xlWhole)
For i = 1 To n
rng1.Offset(RowOffset:=2).EntireRow.Copy
rng1.Offset(RowOffset:=3).EntireRow.Insert
Next i
' Copy and insert row in second range
Set rng2 = Cells.Find(What:="Header 2", LookAt:=xlWhole)
For i = 1 To n
rng2.Offset(RowOffset:=2).EntireRow.Copy
rng2.Offset(RowOffset:=3).EntireRow.Insert
Next i
' Correct the formulas
Range(rng1.Offset(RowOffset:=1), rng2.Offset(RowOffset:=-1)).FillDown
Range(rng2.Offset(RowOffset:=1), rng2.End(xlDown)).FillDown
Application.ScreenUpdating = True
End Sub