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

 

[Ben716161]

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

Yes this works perfectly, thank you very much for your help !!!! Have a great day!!!

 

[Ben716161]

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

Yes it works, the two cells are blank now, thank you. However, I just realized another thing. When it adds the new rows, the Formulas/Functions in the new rows dont get updated. (See images below) On the second image it should be F14-E14 instead of F13-E13. The other columns that contain functions are: H, I and J. Is there a way to make the formulas relate to new added rows?

 

[Legacy 143009]

I haven't tested this. Try:

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).FillUp
      .Cells(i, "G").Resize(, 11).FillUp
    End If
  Next
  End With
End Sub

 

[Ben716161]

I haven't tested this. Try:

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).FillUp
      .Cells(i, "G").Resize(, 11).FillUp
    End If
  Next
  End With
End Sub

So it doesnt seem to work. It ads the row from below now and not the one from above? However the functions get updated, so this works now.

 

[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]

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

Okay, I got it now all right and now everything works as intended. Thank you very much for your help and patience!!!

 

[Legacy 143009]

No problem