is this code causing Excel to lock up/freeze?

[Emjaye]

Can anybody help me please. Why does Excel lock up when pasting data in a workbook which has the following code (below) in each worksheet?

It locks the whole application, not just the active workbook.
It also makes no difference whether or not the destination cell is in the range c4:n34 (as per the intersect command in the code).
Also it doesn't always lock it up, just 90% of the time. (tested on 2 different operating systems with different versions of Excel.)


thank you, Mike
------------------

Private Sub Worksheet_Change(ByVal Target As Range)

' values obtained from admin & help sheet - allows user to change options


On Error GoTo ohdear
Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub 'if > 1 cell selected, exit
ActiveSheet.Unprotect
'
'dim WK entries
If Not (Intersect(Target, Range("d4:n34")) Is Nothing) And Target.Column <> 9 Then 'if <> range d4:n34, and <> col.9 do nothing
'
Dim cell As Range
Dim rng1 As Range
Set rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
If rng1 Is Nothing Then
Set rng1 = Range(Target.Address)
Else
Set rng1 = Union(Range(Target.Address), rng1)
End If
For Each cell In rng1
Select Case cell.Value
'
Case vbNullString 'default
With cell
.Font.Size = 10
.Font.Bold = False
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End With
'get values from admin & help sheet
Case Sheets("Admin & Help").Range("G4"), Sheets("Admin & Help").Range("G5"), Sheets("Admin & Help").Range("G6"), _
Sheets("Admin & Help").Range("G7"), Sheets("Admin & Help").Range("G8"), Sheets("Admin & Help").Range("G9"), _
Sheets("Admin & Help").Range("G10"), Sheets("Admin & Help").Range("G11"), Sheets("Admin & Help").Range("G12"), Sheets("Admin & Help").Range("G13")
With cell
.Font.Size = 8
.Font.FontStyle = "Bold"
.Font.ColorIndex = 48
.Interior.ColorIndex = 40
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
End With
Case Else 'default
With cell
.Font.Size = 10
.Font.Bold = False
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End With
End Select
Next
End If
'
'populate watches
If Not (Intersect(Target, Range("C4:N34")) Is Nothing) Then 'if not in range c4:n34 do nothing
'
If Target.Column = 3 Or Target.Column = 9 Then
If Target.Value = "A" Or Target.Value = "a" Then GoTo awatch 'A watch
If Target.Value = "B" Or Target.Value = "b" Then GoTo bwatch 'B watch
If Target.Value = vbNullString Then
With Target
.Offset(0, 1).ClearContents 'WM
.Offset(0, 2).ClearContents 'WO
.Offset(0, 3).ClearContents 'WO
.Offset(0, 4).ClearContents 'WA
.Offset(0, 5).ClearContents 'WA
End With: End If: End If
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect
End With
GoTo ohdear
'
'get watch members from admin & help sheet
'
awatch: With Target
.Offset(0, 1).Value = Sheets("Admin & Help").Range("C4").Value 'WM
.Offset(0, 2).Value = Sheets("Admin & Help").Range("C5").Value 'WO
.Offset(0, 3).Value = Sheets("Admin & Help").Range("C6").Value 'WO
.Offset(0, 4).Value = Sheets("Admin & Help").Range("C7").Value 'WA
.Offset(0, 5).Value = Sheets("Admin & Help").Range("C8").Value 'WA
End With
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect
End With: GoTo ohdear
bwatch: With Target
.Offset(0, 1).Value = Sheets("Admin & Help").Range("C12").Value 'WM
.Offset(0, 2).Value = Sheets("Admin & Help").Range("C13").Value 'WO
.Offset(0, 3).Value = Sheets("Admin & Help").Range("C14").Value 'WO
.Offset(0, 4).Value = Sheets("Admin & Help").Range("C15").Value 'WA
.Offset(0, 5).Value = Sheets("Admin & Help").Range("C16").Value 'WA
End With: End If
'error
ohdear:
With ActiveSheet
.EnableSelection = xlUnlockedCells
.Protect
End With: Exit Sub
End Sub

 

[erik.van.geit]

Mike,

This code is writing to the sheet, isn't it?
If so the worksheet_change will "endlessly" be activated...

example of unexpected results

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Target.Offset(1, 0) = Target.Offset(1, 0) + 1
End Sub

to avoid this

Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
If flag = True Then Exit Sub
flag = True
If Target.Count > 1 Then Exit Sub
Target.Offset(1, 0) = Target.Offset(1, 0) + 1
flag = False
End Sub

this could be your problem (or part of it)

kind regards,
Erik

 

[Ivan F Moala]

Hi Emjaye

As Eric has pointed out, when you write to the Sheet using Event code
such as Change Event you risk Recursion. To avoid this DisableEvents BEFORE writting then enable them AFTER.

ie

Application.enableevents=false

your code

Application.Enableevents=true

 

[erik.van.geit]

Ivan,

Yes, you use the in-built-funtion enableevents.
Much more professional then mine, but one question.
Which events are disabled? only those of the sheetchange ?

kind regards,
Erik

 

[Ivan F Moala]

Hi Erick, ALL Event procedures are Disabled

 

[erik.van.geit]

OK,
then sometimes only a "little flag" could be more safe in case you exclude other necessary procedures ?
flag = True
or am I dreaming?

kind regards,
Erik

 

[Emjaye]

Thank you guys!

Erik, I like your 'flag' procedure - I'll keep it in mind in future.
Ivan, thank you too; I have made use of the enableevents command.

However! To my embarrassment, it would seem the major problem was that I disabled screenupdating and didn't enable it again - making it appear that excel had locked up. Oh dear.