Forum Discussion
Inserting Rows Automatically
I have tweaked the code. Please replace the existing code with the following code and let me know if this works as desired now.
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub On Error GoTo Skip: If Not Intersect(Target, Range("B:B")) Is Nothing Then Application.EnableEvents = False If Target.Offset(0, -1) <> "" Then If Target <> "" Then Rows(Target.Row + 1).Insert Target.Offset(1, -1) = Target.Offset(0, -1) Else If Application.CountIf(Columns(1), Target.Offset(0, -1).Value) > 1 Then Rows(Target.Row).Delete End If End If End If End If Skip: Application.EnableEvents = True End SubIf that takes care of your original question, please mark your question as Solved by accepting the Answer.
Please place the following code on Sheet Module of the Sheet in which you want this functionality.
To do so, right click on Sheet Tab --> View Code and paste the code given below into the opened code window --> Close the VB Editor --> Save your Workbook as Macro-Enabled Workbook or with any file format which supports Macros e.g. .xlsm or .xls or .xlsb.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
On Error GoTo Skip:
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Application.EnableEvents = False
If Target.Offset(-1, 0) <> "" Then
If Target <> "" Then
Rows(Target.Row + 1).Insert
Target.Offset(1, -1) = Target.Offset(0, -1)
Else
If Application.CountIf(Columns(1), Target.Offset(0, -1).Value) > 1 Then
Rows(Target.Row).Delete
End If
End If
End If
End If
Skip:
Application.EnableEvents = True
End SubPlease find the attached with the code on Sheet1 Module and to test the code, start entering the Info in column B for each department in column A and see if this is what you were trying to achieve.
Subodh_Tiwari_sktneer Thank you for your reply. It is very much what I was looking for however if you look on the picture ( hope you can see it) there are certain rows that it will not work on . So by looking at column A row 2 has worked but (row1), row 4,row 7, row10,row 13,row16,row 19, and every third row there on in does not work. I used Row 1 for a heading although I can use the column heading for that.
Is there a way of amending this macro so that it will work with every line? Also can I format this into a table ?Not to worries about the latter though.
I have tweaked the code. Please replace the existing code with the following code and let me know if this works as desired now.
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub On Error GoTo Skip: If Not Intersect(Target, Range("B:B")) Is Nothing Then Application.EnableEvents = False If Target.Offset(0, -1) <> "" Then If Target <> "" Then Rows(Target.Row + 1).Insert Target.Offset(1, -1) = Target.Offset(0, -1) Else If Application.CountIf(Columns(1), Target.Offset(0, -1).Value) > 1 Then Rows(Target.Row).Delete End If End If End If End If Skip: Application.EnableEvents = True End SubIf that takes care of your original question, please mark your question as Solved by accepting the Answer.
Subodh_Tiwari_sktneerThank you it resolves my original question yes … am I able to use this in a table as well? Also how do I mark it as solved please?