Insert and Delete Rows in Entire Workbook

[qtravnlr]

Good evening everyone. I am trying to create a code that will allow me to insert and/or delete a row of data for multiple sheets inside a workbook. To give you a little background I have the first sheet as just an employee seniority list, then multiple sheets after that tracking various information for each employee. I would like to be able to add a new row for a new employee on the seniority list and it adjust the list on every other sheet keeping the entered information with the correct employee. Also, when an employee is no longer with the company I would like to be able to delete the entire row on every sheet at once. I found the following code to use to add/delete a row, but would like to adjust the coding to add/delete for every sheet in the workbook, not just the current one. Also would be be possible to set up the coding to also copy in information entered in the new row in sheet 1 to the other sheets as well? I know nothing about VBA and any help would be greatly appreciated!

==========================================


Public Sub AddDeleteRow()
Dim mpSelect As String
Dim mpRow As Range

mpSelect = InputBox("Choose to add (A) or delete (D) a row")
If UCase(mpSelect) = "D" Then

Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will delete", Type:=8)
mpRow.EntireRow.Delete
Else

Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will add after", Type:=8)
mpRow.Offset(1, 0).EntireRow.Insert
Cells(mpRow.Row, "N").Resize(, 3).Copy Cells(mpRow.Row + 1, "N")
End If
End Sub

[Teeroy]

Hi qtravnlr,

You just need to loop your code through the sheets collection and fully reference your range object (including worksheet). You also have to take the .Row property of mpRow to another variable because after the first row delete the mpRow object no longer exists and you'd get an error.

Please use the VBA Tags to enclose your code as it is far easier to read.


Public Sub AddDeleteRow()
Dim mpSelect As String
Dim mpRow As Range
Dim lRowNo As Long
Dim sheet

mpSelect = InputBox("Choose to add (A) or delete (D) a row")
If UCase(mpSelect) = "D" Then
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will delete", Type:=8)
lRowNo = mpRow.Row
For Each sheet In Sheets
sheet.Rows(lRowNo).EntireRow.Delete
Next
Else
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will add after", Type:=8)
lRowNo = mpRow.Row
For Each sheet In Sheets

sheet.Rows(lRowNo + 1).EntireRow.Insert
sheet.Cells(lRowNo, "N").Resize(, 3).Copy Destination:=Cells(lRowNo + 1, "N")
Next
End If
End Sub

[qtravnlr]

Awesome! Thank you so much for the help! Now on to figuring out how to have text entered in that new row to be entered in all three sheets at once! :-)


Hi qtravnlr,

You just need to loop your code through the sheets collection and fully reference your range object (including worksheet). You also have to take the .Row property of mpRow to another variable because after the first row delete the mpRow object no longer exists and you'd get an error.

Please use the VBA Tags to enclose your code as it is far easier to read.


Public Sub AddDeleteRow()
Dim mpSelect As String
Dim mpRow As Range
Dim lRowNo As Long
Dim sheet

mpSelect = InputBox("Choose to add (A) or delete (D) a row")
If UCase(mpSelect) = "D" Then
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will delete", Type:=8)
lRowNo = mpRow.Row
For Each sheet In Sheets
sheet.Rows(lRowNo).EntireRow.Delete
Next
Else
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will add after", Type:=8)
lRowNo = mpRow.Row
For Each sheet In Sheets

sheet.Rows(lRowNo + 1).EntireRow.Insert
sheet.Cells(lRowNo, "N").Resize(, 3).Copy Destination:=Cells(lRowNo + 1, "N")
Next
End If
End Sub

[patel]

Sub AddDeleteRow()
Dim mpSelect As String
Dim mpRow As Range
mpSelect = InputBox("Choose to add (A) or delete (D) a row")
If UCase(mpSelect) = "D" Then
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will delete", Type:=8)
aRow = mpRow.Row
For sh = 1 To Sheets.Count
Sheets(sh).Rows(aRow).Delete
Next
Else
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will add after", Type:=8)
For sh = 1 To Sheets.Count
Sheets(sh).Rows(mpRow.Row + 1).Insert
Sheets(sh).Rows(mpRow.Row).Copy Sheets(sh).Cells(mpRow.Row + 1, "a")
Next
End If
End Sub

[qtravnlr]

Hi Patel, thanks for the code, however when I add a row, it actually copies the information from the previous row into the new row when I actually just want it to add a blank row then when I add information to the row it will update the other sheets at that time. Is that possible?


Sub AddDeleteRow()
Dim mpSelect As String
Dim mpRow As Range
mpSelect = InputBox("Choose to add (A) or delete (D) a row")
If UCase(mpSelect) = "D" Then
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will delete", Type:=8)
aRow = mpRow.Row
For sh = 1 To Sheets.Count
Sheets(sh).Rows(aRow).Delete
Next
Else
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will add after", Type:=8)
For sh = 1 To Sheets.Count
Sheets(sh).Rows(mpRow.Row + 1).Insert
Sheets(sh).Rows(mpRow.Row).Copy Sheets(sh).Cells(mpRow.Row + 1, "a")
Next
End If
End Sub

[Teeroy]

This might be do what you want assuming it's the first column you want on every sheet. This will copy the first column from sheet 1 to every sheet whenever you leave Sheet1.

Public Sub AddDeleteRow()
Dim mpSelect As String
Dim mpRow As Range
Dim lRowNo As Long
Dim sheet

mpSelect = InputBox("Choose to add (A) or delete (D) a row")
If UCase(mpSelect) = "D" Then
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will delete", Type:=8)
lRowNo = mpRow.Row
For Each sheet In Sheets
sheet.Rows(lRowNo).EntireRow.Delete
Next
Else
Set mpRow = Application.InputBox("Use the mouse to select any cell in the row you will add after", Type:=8)
lRowNo = mpRow.Row
For Each sheet In Sheets

sheet.Rows(lRowNo + 1).EntireRow.Insert
'sheet.Cells(lRowNo, "N").Resize(, 3).Copy Destination:=sheet.Cells(lRowNo + 1, "N")' Commented out as this copies col N,O & P to the new row
Next
End If
End Sub

Sub UpdateColumn1()
Dim i As Integer

For i = 2 To Sheets.Count
Sheets(i).Activate
ActiveSheet.Range("A1").PasteSpecial xlPasteValues
Next
End Sub
and in Sheet1 code container

Private Sub Worksheet_Deactivate()
Me.Columns(1).Copy
UpdateColumn1
End Sub

[patel]

Hi Patel, thanks for the code, however when I add a row, it actually copies the information from the previous row into the new row when I actually just want it to add a blank row then when I add information to the row it will update the other sheets at that time. Is that possible?

eliminate row
Sheets(sh).Rows(mpRow.Row).Copy Sheets(sh).Cells(mpRow.Row + 1, "a")

[qtravnlr]

Maybe this will help to understand what I am trying to do (and I do apoligize I am very new at this and my explainations are not very clear): In addition to adding/deleting rows that has been solved by the above code, I want to:

When you select several worksheets and then change the data on one of them, the changes are applied to the same cells on all the selected worksheets.

Click the tab of the first worksheet that contains the data that you want to edit. Then hold down CTRL while you click the tabs of other worksheets that contain the same data. Edit the data in the selected cell, and then press ENTER or TAB to move the selection to the next cell.
Repeat the previous step until all the changes have been made.In particular it is columns 1-3 that are idential on every worksheet and those are the columns that need to be updated simultaneously.

Thanks again for all of the help so far!

[Teeroy]

You've said Sheet1 is your master so the easiest thing to do is to make the changes there and copy the data to the other sheets when you leave it.

A small change in the Sheet1 code to copy 3 columns, the rest is as per my last post:


Private Sub Worksheet_Deactivate()
Me.Columns("A:C").Copy
UpdateColumn1
End Sub