Insert/Delete Rows on 2 sheets simultaneously

[klutz]

Hello All,

I have the below code that some of you helped me out on a few weeks ago.

Right now this code is inserted for one particular worksheet Named Data1

I was wondering if this macro can add or delete rows on another sheet named "Data2" simultaneously?

So, if I insert 10 rows on sheet named DATA1 row 33 it can also add 10 rows on sheet named DATA2 starting fro Row 33 as well.

Any thoughts?



[VBA]

Public Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim cell As Range
Dim endRow As Long
Dim startRow As Long
Dim requiredRows As Long
Dim exisistingRows As Long
Me.Unprotect Password:="pwd"
'Single cell only, please
If Target.Columns.Count > 1 Then Exit Sub
'//Check if Col 'F'
If Target.Column = 6 Then
If Target.Offset(0, -1) <> "" Then
requiredRows = Target

'Don't delete first FOUR rows to not lose important formulas
If requiredRows < 5 Then
requiredRows = 5
End If

startRow = Target.row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 300
If Cells(r, "E").Interior.ColorIndex <> 20 Then
endRow = r - 1
Exit For
End If
Next r
exisistingRows = endRow - startRow + 1

Application.EnableEvents = False
If requiredRows > exisistingRows Then
'add rows
For r = exisistingRows To requiredRows - 1
Rows(startRow + r).Insert
Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Range("H" & startRow + r & ":t" & startRow + r).ClearContents
Next r
MsgBox "You now have " & targetRow + r & " rows for Insured Location Entry !", vbOKOnly
ElseIf requiredRows < exisistingRows Then
'delete rows
Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete
MsgBox "You have now deleted " & exisistingRows - requiredRows & " additional rows!", vbOKOnly
End If
Application.EnableEvents = True
Me.Protect Password:="pwd"
End If
'//Else check if in Range, Column 'D'
ElseIf Not Intersect(Target, Range("d24:d290")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then
MakeChange cell.Offset(, 3)
Else
cell.Interior.ColorIndex = 20
End If
Next cell
End If
End Sub

[/VBA]

[Benzadeus]

What about
[VBA] If requiredRows > exisistingRows Then
'add rows
For r = exisistingRows To requiredRows - 1
'For sheet DATA1
Rows(startRow + r).Insert
Rows(startRow + r).Insert
Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Range("H" & startRow + r & ":t" & startRow + r).ClearContents

'For sheet DATA2
Sheets("DATA2").Rows(startRow + r).Insert
Sheets("DATA2").Rows(startRow + r).Insert
Sheets("DATA2").Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Sheets("DATA2").Range("H" & startRow + r & ":t" & startRow + r).ClearContents
Next r
MsgBox "You now have " & targetRow + r & " rows for Insured Location Entry !", vbOKOnly
ElseIf requiredRows < exisistingRows Then
'delete rows

'For sheet DATA1
Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete

'For sheet DATA2
Sheets("DATA2").Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete

MsgBox "You have now deleted " & exisistingRows - requiredRows & " additional rows!", vbOKOnly
End If[/VBA]

[klutz]

Thank you for your quick help on this.

Unfortunately, while it does insert the additional rows entered - they are without the formulas from the rows above. Also the macro is not deleting the rows inserted.

Thanx...

Any thoughts...

[Benzadeus]

they are without the formulas from the rows above.

Change [vba]Sheets("DATA2").Rows(startRow + r - 1).Copy Range("a" & startRow + r)[/vba]
for [vba]Rows(startRow + r - 1).Copy Sheets("DATA2").Range("a" & startRow + r)[/vba]
I think it will fix this issue.

the macro is not deleting the rows inserted.

I can't figure why the macro isn't deleting it.

[klutz]

Thanks for your help buddy.

With the added change it now inserts the formulas correctly on sheet DATA1 but it also copies those same formulas into the inserted rows on sheet DATA2.

Sheet DATA2 has its own set of formulas different from sheet DATA1.

Unfortunately the macro does not delete the rows when called for it.

Not sure what to do anymore...

Any thoughts?


Klutz---oooooo

[Benzadeus]

but it also copies those same formulas into the inserted rows on sheet DATA2.

Sheet DATA2 has its own set of formulas different from sheet DATA1.

So in DATA2 the action is ONLY to add empty rows when added in DATA1?

Unfortunately the macro does not delete the rows when called for it.

That's strange, because
[VBA]Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete[/VBA]
Should delete rows in DATA1 and
[VBA]Sheets("DATA2").Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete[/VBA]
should delete rows in DATA2!

[klutz]

Hi Buddy, yeah, it wasn't deleting up until i delete the one of the below bold/underlined code. When I wanted to insert 2 rows it would 4 rows instead and when trying to delete 2 rows it wouldn't do it. Deleting those 2 lines now inserts and deletes properly.

[VBA] 'For sheet DATA1
Rows(startRow + r).Insert
Rows(startRow + r).Insert

Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Range("H" & startRow + r & ":t" & startRow + r).ClearContents

'For sheet DATA2
Sheets("DATA2").Rows(startRow + r).Insert
Sheets("DATA2").Rows(startRow + r).Insert
[/VBA]


Quote: Originally Posted by: klutz but it also copies those same formulas into the inserted rows on sheet DATA2.

So in DATA2 the action is ONLY to add empty rows when added in DATA1?




DATA2 sheet actually has its own set of formulas in their rows, so if I insert an additional row it would copy the formula from the row above and place it in the new row...What it is doing right now is actually copying the formulas form DATA1 sheet and pasting them in the neely inserted row on DATA2 sheet.

I played around with it but couldn't get it to properly work.


Thanks for your help again...

[Benzadeus]

Change
[VBA]

Rows(startRow + r - 1).Copy Sheets("DATA2").Range("a" & startRow + r)

[/VBA]
for
[VBA]

Sheets("DATA2").Rows(startRow + r - 1).Copy Sheets("DATA2").Range("a" & startRow + r)

[/VBA]