This Worksheet_Change sub doesn't work - why?

[Gunnar Johansson]

Hi,
In case of change of cells within two areas, I want to restore the format in
the areas from the format source cell "C1" AND also replicate the cell
values from sheet1 to sheet2. It doesn't work. I'm grateful to any help!
Thanks in advance.

/Gunnar

Private Sub Worksheet_Change(ByVal Target As Range)
'**************************************
On Error GoTo errorhandler1

Application.ScreenUpdating = False
Application.EnableEvents = False
sheet1.Unprotect

'Restore format
'Replicate values to other sheet
If Not Application.Intersect(Target, Range("A1:B2"), Range("A4:B5")) Is
Nothing Then
sheet1.Range("C1").Copy
sheet1.Range("A1:B2").PasteSpecial (xlPasteFormats)
sheet1.Range("A4:B5").PasteSpecial (xlPasteFormats)

sheet2.Unprotect
sheet2.Range("A1:B2").Value = sheet1.Range("A1:B2").Value
sheet2.Range("A4:B5").Value = sheet1.Range("A4:B5").Value
End If

' Normal end of Sub
Application.ScreenUpdating = True
Application.EnableEvents = True
sheet1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
sheet1.EnableSelection = xlUnlockedCells
Exit Sub

'Error handler - protect & end sub when error occure
errorhandler1: MsgBox prompt:="Unexpected error (errorcode " &
Str$(Err.Number) & ") in Sub Worksheet_Change " & vbCrLf _
& "Description: " & Err.Description, _
Buttons:=vbCritical + vbMsgBoxHelpButton, _
Title:="Error!", _
HelpFile:=Err.HelpFile, _
Context:=Err.HelpContext

Application.ScreenUpdating = True
Application.EnableEvents = True
Blad1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Blad1.EnableSelection = xlUnlockedCells
Exit Sub

End Sub

 

[Norman Jones]

Hi Gunnar,

Without otherwise looking at your code, you have a problem in the line:

If Not Application.Intersect(Target, Range("A1:B2"), Range("A4:B5")) Is
Nothing Then

as Range("A1:B2") and Range("A4:B5") can never intersect and, therefore the
above expression will always resolve to Nothing.

I suspect that you want:

If Not Application.Intersect(Target, _
Union(Range("A1:B2"), Range("A4:B5"))) Is Nothing Then

 

[Gunnar Johansson]

Thank you, now it work perfectly! I'll study the Union method a bit more...
/Gunnar