klutz
09-03-2009, 10:11 AM
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?
:help
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
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?
:help
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