Forum Discussion
Inserting Rows Automatically
I have created a table and in column A I have the departments and in column B I have item numbers. What i want to be able to do automatically is when I enter an additional number onto column B it inserts a row so that I can then increase the amount of numbers I want to put into column B under the same department.
This way I can keep adding numbers to column B under each department. This will expand the spreadsheet.
Any help would be much appreciated.
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.
10 Replies
Hi
I can understand your question in 2 different ways:
1- when you add a number ANYWHERE in column B you want a new row inserted at the bottom of the Table.
2- When you add a number in the LAST empty cell in column B in your table you need a new row to be added to the table.
For option 1, you can add a spin button that Inserts or delete rows. If you are familiar with VBA and inserting controls then insert a spin button control and write this code for the button. It will insert/Delete a row with each click
Private Sub SpinButton1_SpinDown()
Dim LastRow As Long
LastRow = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Rows(LastRow - 1).EntireRow.Delete
End Sub
Private Sub SpinButton1_SpinUp()
Dim LastRow As Long
LastRow = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Rows(LastRow).EntireRow.Insert
End Sub
For Option 2 you also need to write a code for inserting a row but this time, attach it to the Change Event of the first empty cell in column B...
In either case I would have a preference to do it manually using the regular functionality of Excel.
Good Luck
- Sorry forgot to mention I am pretty naïve and do not know about VBA
nabilmouradthank you for your reply.... I am not wanting to insert another row at the bottom... So if you take column A in each row there is a department lets say for instance it is department 1 to 10 . What I want to be able to do is to put info into column B next to the department number and then be able to press enter and it will give me another row under it. This means I can add more info onto department 1. It will end up looking like say 10 bits of info under dept1 and maybe 20 bits of info under department 2 and so on... Does that make sense.
If not, lets say column A row 1 I will put a department number in it. I want to add info into column B row 1 and when I press enter it will give me another row which would be row 2 but there will already be in Column A row 2 another department number but by pressing enter after the former I have mentioned it will move that one to Column A row 3 and so on.
Why not upload a sample file with some dummy data to show us what you have and mock up the desired output manually on another sheet and explain about the steps you would like to automate to get the desired output?
- please see my response to other reply.Thank you
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.
