C
Casey
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
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