Referencing issue when running insert-rows-Macro

[MAngosto]

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 set of rows 3-5 and 9-11. Each of these sets of rows contain 3 rows. I then have a macro that inserts a row to each of these sets. That is, whenever I need a new product name, 1 row is inserted in the first set, that would then go from 3-6 and 1 row is inserted in the second set, that would then go from 10-13.

The pieces of code of that macro look as follows:

Sub Add_Rows()

Application.ScreenUpdating = False

    Sheets("Sheet1").Select
    Cells.Find(What:="Header 1", After:=ActiveCell, LookIn _
        :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(rowOffset:=2).Activate
    ActiveCell.EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(rowOffset:=1).Activate
    Selection.Insert Shift:=xlDown
    
    Sheets("Sheet1").Select
    Cells.Find(What:="Header 2", After:=ActiveCell, LookIn _
        :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(rowOffset:=2).Activate
    ActiveCell.EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(rowOffset:=1).Activate
    Selection.Insert Shift:=xlDown

Application.ScreenUpdating = True

End Sub

The problem I have is that there are cells in all these rows that reference the other set of rows at the same time. That is, explained by colors (see attached document), cells in the first set of rows reference both cells in the same set of rows (blue) and cells in the second set of rows (orange). At the same time, cells in the second set of rows reference cells in the first one (blue and green).

The real issue is that, whatever the order of the inserted rows in the VBA code is, there will always be some referencing that will be broken.

I want that whenever the row is added, it follows the formulation of the cells above/below accordingly, but the formulation breaks (naturally, because it tries to reference a row that is not yet created).

Is there any possibility to write additional code in order to handle this? Is it possible to write the code in a way that creates all rows simultaneously instead of reading the order of writing? Is this even possible to be worked around? I have tried with "Application.Calculation = xlCalculationManual" at the beggining and "Application.Calculation = xlCalculationAutomatic" at the end, but it does not work.

Would the only solution be to first create all rows and then write the code to fill the formulation of all these newly inserted rows accordingly?

Any help would be appreaciated.

Martin

[#2]

@MAngosto 

The formula in row 3 is = A3 + A8 + B8 but the second range begins in row 9. Is that intentional?

[#3]

@Hans Vogelaar 

Oops! Thanks for spotting that! It should be A3 + A9 + B9 and the following rows accordingly (A4 + A10 + B10 ...)

Any ideas?

[#4]

@MAngosto 

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 Sub

[#5]

@Hans Vogelaar 

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.

[#6 · Accepted solution]

@MAngosto 

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

[#7]

@Hans Vogelaar 

Thank you so much! It is always a pleasure receiving help with your VBA knowledge!