is this code causing Excel to lock up/freeze?

Emjaye

Board Regular
Joined
Oct 3, 2003
Messages
89
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
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Mike,

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

example of unexpected results
Code:
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
Code:
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

MrExcel MVP
Joined
Feb 10, 2002
Messages
4,209
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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

MrExcel MVP
Joined
Feb 10, 2002
Messages
4,209

ADVERTISEMENT

Hi Erick, ALL Event procedures are Disabled
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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

Board Regular
Joined
Oct 3, 2003
Messages
89
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. :oops:
 

Watch MrExcel Video

Forum statistics

Threads
1,123,384
Messages
5,601,323
Members
414,442
Latest member
Oleg

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top