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

Ben716161

New Member
Joined
May 9, 2023
Messages
9
Office Version
  1. 2016
Platform
  1. Windows
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

1683631110432.png



VBA Code:
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
 
OK I think I won't be able to figure it out to handle with a single line. Try this:
VBA Code:
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!!!
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
OK I think I won't be able to figure it out to handle with a single line. Try this:
VBA Code:
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?



1683711131421.png

1683711164977.png
 
Upvote 0
I haven't tested this. Try:
VBA Code:
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
 
Upvote 0
I haven't tested this. Try:
VBA Code:
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. :)

1683712553413.png
 
Upvote 0
If you want the formula above, then this could work also:
VBA Code:
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
 
Upvote 1
Solution
If you want the formula above, then this could work also:
VBA Code:
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!!! :) :) :)
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,265
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top