Apr 29 2024 03:05 AM - edited Apr 29 2024 03:32 AM
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
Apr 29 2024 05:05 AM
The formula in row 3 is = A3 + A8 + B8 but the second range begins in row 9. Is that intentional?
Apr 29 2024 05:34 AM - edited Apr 29 2024 06:21 AM
Oops! Thanks for spotting that! It should be A3 + A9 + B9 and the following rows accordingly (A4 + A10 + B10 ...)
Any ideas?
Apr 29 2024 06:31 AM
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
Apr 29 2024 06:45 AM
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.
Apr 29 2024 06:57 AM
SolutionSub 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
Apr 29 2024 07:05 AM
Apr 29 2024 06:57 AM
SolutionSub 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