Automate insertion of row data

[MrJJP]

Hello, would like to automatically add certain row data when data in other cells is added. In the below screenshot I have unchanging data in columns B & C, with the expectation that users will input data into the respective columns D, E & F. So my starting point in the example is B2:F5, and I would like it to come out to looking like the example in B8:F13. Another way to say this, is in B8:F13, if a user input the data into D8, E8, and/or F8, upon hitting enter, it would create a new row underneath it with blanks (ready for the next user's input) into D9:F9, but still copy/retain the original data values from B8 and C8. I'd prefer to do it without VBA, but can muster through that with any additional help (my total number of rows will be around 35 and I may have 3-4 additional columns). Thanks for any help!

 

[myall_blues]

You can't do it without VBA because it's not possible to change a worksheet structure with formulas (i.e. insert rows etc). So to that end:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cRow As Long
    If Intersect(Target, Range("D3:F40")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    cRow = Target.Row
    Range("B" & cRow & ":C" & cRow).Copy
    Range("B" & cRow + 1).Insert Shift:=xlDown
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

This code needs to go in the Worksheet_Change event of your worksheet. To do that open the VBA editor (ALT+F11) and on the left hand side right-click on the sheet you're working in and click View Code. Then paste the code in the window that appears.

 

[MrJJP]

Thanks for the assistance, very much appreciated! It's working in part but there is an issue though I think I figured out solution. So the issue that I was facing is when I place my cursor in the "Date" column (D), enter a date, and then press tab to enter data into the "Participants" column, it would add a row, and then when I would tab to the "POC" (F) column, it would add yet another row. What I did, and please tell me if this will work (it did on my test run, but want to be wary of any potential issues), is I changed the 3rd line of the code for the "(Target, Range("F3:F40")..." so only when a value in column F is added, will it add a duplicate row.
Also, I added a few extra columns in my final sheet to be copied, so instead of just columns B and C, it's B, C, D. I think I would just change the 6th line of code from "C" to "D"? Thanks again!!

 

[myall_blues]

Yes correct on both counts.

 

[MrJJP]

Great, thanks for your help myall_blues!!

 

[myall_blues]

You’re welcome. Glad it worked for you.

 

[MrJJP]

Hello, I came across one more issue with regards to the above. If there is an error, and I need to delete a row, or delete the contents, it then adds a row since it recognizes there is a data added to the selected cell. I've tried deleting/clearing the contents from the entire row, as well as deleting the records from cells B:E (omitting column F since that was the "trigger" for the macro. However, I'm perplexed as to how to edit the data without messing up the content from the other rows. Thanks again for any help!

 

[myall_blues]

Hi
This modification to the code will make it ignore operations that affect multiple columns. So for example if you delete an entire row(s) or select a group of cells and press delete it will ignore it.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cRow As Long
    If Intersect(Target, Range("F3:F40")) Is Nothing Or Target.Columns.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    cRow = Target.Row
    Range("B" & cRow & ":D" & cRow).Copy
    Range("B" & cRow + 1).Insert Shift:=xlDown
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

 

[MrJJP]

Hi
This modification to the code will make it ignore operations that affect multiple columns. So for example if you delete an entire row(s) or select a group of cells and press delete it will ignore it.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cRow As Long
    If Intersect(Target, Range("F3:F40")) Is Nothing Or Target.Columns.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    cRow = Target.Row
    Range("B" & cRow & ":D" & cRow).Copy
    Range("B" & cRow + 1).Insert Shift:=xlDown
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

That works great, thanks for the resolution and sharing your knowledge, very helpful and appreciated!!

 

[MrJJP]

Sorry, again I ran into a snag... Now when I enter data into a blank row, it essentially shifts the data from the row beneath, into the "new" copied row. For example, (with two updated screenshots below) I added data to row 6, it did create the duplicate information I wanted from B6:G6, however the previously input data from I7:L7 was shifted into the "new" row 7, filling in information on that row instead of being retained into the correct row. Again, apologies for the back and forth, especially when I thought I had it all set.