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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Hello! This should work:
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).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
 
Upvote 1
Hello! This should work:
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).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?
 
Upvote 0
No, not actually.. Maybe it can not find the last row to begin. Change this line:
VBA Code:
Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
to something like:
VBA Code:
Set myRange = Range("A2:Q10000")
where ever your data goes...

Also try to modify this line:
VBA Code:
If .Cells(i, "P").Offset(-1).Formula = "abcde" Then
like this:
VBA Code:
If .Cells(i, "P").Offset(-1).Value = "abcde" Then
 
Upvote 1
No, not actually.. Maybe it can not find the last row to begin. Change this line:
VBA Code:
Set myRange = Range("A2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
to something like:
VBA Code:
Set myRange = Range("A2:Q10000")
where ever your data goes...

Also try to modify this line:
VBA Code:
If .Cells(i, "P").Offset(-1).Formula = "abcde" Then
like this:
VBA Code:
If .Cells(i, "P").Offset(-1).Value = "abcde" Then
Hello,

thank you so much, it worked!!!!

I hope you have a great day!!! :)
 
Upvote 0
Glad it did work! Thanks for the feedback (y)
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!!!

1683643299917.png
 
Upvote 0
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.
 
Upvote 0
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.
Hello,
sorry for answering only now. So basically as seen in the image below, I run the VBA and it added a new row in row 15, 27 and 33. However, it also added the dates in the columns E15 F15, E27 F27; E33 F33 instead of leaving a blank. I also added the VBA below the picture, maybe I made an error?
1683700645047.png

VBA Code:
Sub test()
  Dim myRange As Range
  Set myRange = Range("A2:Q10000")
  With myRange
  For i = .Rows.Count To 3 Step -1
    If .Cells(i, "P").Offset(-1).Value = "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
 
Upvote 0
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
 
Upvote 1

Forum statistics

Threads
1,216,095
Messages
6,128,794
Members
449,468
Latest member
AGreen17

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