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
Oops! Thanks for spotting that! It should be A3 + A9 + B9 and the following rows accordingly (A4 + A10 + B10 ...)
Any ideas?
Try this:
Sub Add_Rows()
Dim rng1 As Range
Dim rng2 As Range
Application.ScreenUpdating = False
Sheets("Sheet1").Select
' Copy and insert row in first range
Set rng1 = Cells.Find(What:="Header 1", LookAt:=xlWhole)
rng1.Offset(rowOffset:=2).EntireRow.Copy
rng1.Offset(rowOffset:=3).EntireRow.Insert
' Copy and insert row in second range
Set rng2 = Cells.Find(What:="Header 2", LookAt:=xlWhole)
rng2.Offset(rowOffset:=2).EntireRow.Copy
rng2.Offset(rowOffset:=3).EntireRow.Insert
' Correct the formulas in the first range
Range(rng1.Offset(1), rng1.End(xlDown)).FillDown
Application.ScreenUpdating = True
End SubThank 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 SubLet 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