VBA that adds a new row, with data from the previous row, if certain criterias are met

[Ben716161]

Hello everyone,

I hope you can help me with my VBA problem. Basically I have a sheet with a table and I started working on a VBA that adds a new row below each row thats contains "abcde" in column P (see table on the image below; the VBA is below the image). But now my problem is that new row must contain certain values from the previous row.
So if we take the new row 15. It must contain the values from cells A14:D14 and G14:Q14. The same for row 27, taking the values from row 26 etc. The only rows that need to be filled manually are E and F.
Also note that some cells contain functions, formulas and others dont.
Also the first row for each "Name" gets added manually. (like row 4, 16, 28)
I am new to VBA and coding in general and dont know what to do now and I would really appreciate any help I get . If you have more questions feel free to ask me!

Thank you

Sub ABCDETEST()

   Dim Rng As Range
   Dim WorkRng As Range
   On Error Resume Next
   xTitleId = "Enter the value"
   Set WorkRng = Application.Selection
   Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
   Set WorkRng = WorkRng.Columns(1)
   xLastRow = WorkRng.Rows.count
   Application.ScreenUpdating = False
   For xRowIndex = xLastRow To 1 Step -1
      Set Rng = WorkRng.Range("A" & xRowIndex)
      If Rng.Value = "abcde" Then
         Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
         Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row, ActiveCell.Column)).PasteSpecial Paste:=xlPasteFormulas
         End If
   Next
   Application.ScreenUpdating = True

End Sub

 

[Legacy 143009]

Hello! This should work:

Sub test()
  Dim myRange As Range
  Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
  With myRange
  For i = .Rows.Count To 3 Step -1
    If .Cells(i, "P").Offset(-1).Formula = "abcde" Then
      .Rows(i).EntireRow.Insert
      Range(myRange(i, "A").Resize(, 4), myRange(i, "G").Resize(, 11)).Formula = Range(myRange(i, "A").Resize(, 4), myRange(i, "G").Resize(, 11)).Offset(-1).Formula
    End If
  Next
  End With
End Sub

 

[Legacy 143009]

No, not actually.. Maybe it can not find the last row to begin. Change this line:

Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)

to something like:

Set myRange = Range("A2:Q10000")

where ever your data goes...

Also try to modify this line:

If .Cells(i, "P").Offset(-1).Formula = "abcde" Then

like this:

If .Cells(i, "P").Offset(-1).Value = "abcde" Then

 

[Legacy 143009]

OK I think I won't be able to figure it out to handle with a single line. Try this:

Sub test()
  Dim myRange As Range
  Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
  With myRange
  For i = .Rows.Count To 3 Step -1
    If .Cells(i, "P").Offset(-1).Value = "abcde" Then
      .Rows(i).EntireRow.Insert
      .Cells(i, "A").Resize(, 4).Formula = .Cells(i, "A").Resize(, 4).Offset(-1).Formula
      .Cells(i, "G").Resize(, 11).Formula = .Cells(i, "G").Resize(, 11).Offset(-1).Formula
    End If
  Next
  End With
End Sub

 

[Legacy 143009]

If you want the formula above, then this could work also:

Sub test()
  Dim myRange As Range
  Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
  With myRange
  For i = .Rows.Count To 3 Step -1
    If .Cells(i, "P").Offset(-1).Value = "abcde" Then
      .Rows(i).EntireRow.Insert
      .Cells(i, "A").Offset(-1).Resize(2, 4).FillDown
      .Cells(i, "G").Offset(-1).Resize(2, 11).FillDown
    End If
  Next
  End With
End Sub

 

[Ben716161]

Hello! This should work:

Sub test()
  Dim myRange As Range
  Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
  With myRange
  For i = .Rows.Count To 3 Step -1
    If .Cells(i, "P").Offset(-1).Formula = "abcde" Then
      .Rows(i).EntireRow.Insert
      Range(myRange(i, "A").Resize(, 4), myRange(i, "G").Resize(, 11)).Formula = Range(myRange(i, "A").Resize(, 4), myRange(i, "G").Resize(, 11)).Offset(-1).Formula
    End If
  Next
  End With
End Sub

Hello!

Thank you very much for your answer, however when i test it out nothing happens.
Sidenote: On the original folder the table starts at row 9, so id guess id have to change the Range to A9 instead of A2 right?

 

[Ben716161]

No, not actually.. Maybe it can not find the last row to begin. Change this line:

Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)

to something like:

Set myRange = Range("A2:Q10000")

where ever your data goes...

Also try to modify this line:

If .Cells(i, "P").Offset(-1).Formula = "abcde" Then

like this:

If .Cells(i, "P").Offset(-1).Value = "abcde" Then

Hello,

thank you so much, it worked!!!!

I hope you have a great day!!!

 

[Legacy 143009]

Glad it did work! Thanks for the feedback

 

[Ben716161]

Glad it did work! Thanks for the feedback

Although, i just noticed one small thing. In the added rows in columns F to H the values are crossed out.
Is there a way that it does not add anything in E and F? Since the value in G15 is F15-E15 and H15 is based of the results of G15.
FYI: If you respond in the next hours, I wont see it until tomorrow.

Thank you very much for your help so far tho!!!

 

[Legacy 143009]

It didn't add any value to E and F when I tested the code. Could you explain a little bit more please? I didn't get what you mean exactly.