Excel locks with Worksheet Change procedure
 

Hi,
I have a long but not complicated Worksheet Change procedure that I'
pretty sure is the reason Excel locks up when I right click a range o
unprotected cells and use "Clear Contents", but I have no clue why.
Here is the Code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, j As Long, k As Long, l As Long
Dim irng As Range, jrng As Range, krng As Range, lrng As Range
Dim strInv As String, strRetInv As String

On Error GoTo ws_exit
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("geekk")


If Not Intersect(Target, Range("irng")) Is Nothing Then

For i = 3 To 5
If Columns(i).ColumnWidth 8 Then
Columns(i).ColumnWidth = 8
End If
Next i
Me.Cells.Columns("C:E").AutoFit
For i = 3 To 5
If Columns(i).ColumnWidth < 8 Then
Columns(i).ColumnWidth = 8
End If
Next i

End If

If Not Intersect(Target, Range("jrng")) Is Nothing Then

For j = 6 To 13
If Columns(j).ColumnWidth 8 Then
Columns(j).ColumnWidth = 8
End If
Next j
Me.Cells.Columns("F:M").AutoFit
For j = 6 To 13
If Columns(j).ColumnWidth < 8 Then
Columns(j).ColumnWidth = 8
End If
Next j

End If

If Not Intersect(Target, Range("krng")) Is Nothing Then

For k = 14 To 21
If Columns(k).ColumnWidth 8 Then
Columns(k).ColumnWidth = 8
End If
Next k
Me.Cells.Columns("N:U").AutoFit
For k = 14 To 21
If Columns(k).ColumnWidth < 8 Then
Columns(k).ColumnWidth = 8
End If
Next k

End If

If Not Intersect(Target, Range("lrng")) Is Nothing Then

For l = 22 To 24
If Columns(l).ColumnWidth 8 Then
Columns(l).ColumnWidth = 8
End If
Next l
Me.Cells.Columns("V:X").AutoFit
For l = 22 To 24
If Columns(l).ColumnWidth < 8 Then
Columns(l).ColumnWidth = 8
End If
Next l

End If

strInv = Sheets("PayApp").Range("InvInvoice").Text
If Intersect(Target, Me.Range("InvInvoice")) Is Nothing Then GoT
RET
Me.cmdSaveAsRPPP.Caption _
= "Save and File Invoice # " & strInv

RET:

strRetInv = Sheets("PayApp").Range("InvRetInvoice").Text
If Intersect(Target, Me.Range("InvRetInvoice")) Is Nothing The
Exit Sub
Me.cmdSaveRetain.Caption _
= "Save and File Retainage Invoice # " & strRetInv

ws_exit:
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveSheet.Protect ("geekk")
End Su

--
Case

-----------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...nfo&userid=454
View this thread: http://www.excelforum.com/showthread.php?threadid=52528