This code is taking way too long to display the actions that it
executes. Excel takes too long "calculating cells." It didn’t used to
be that way. I was wondering if anyone knows why this may be. The Excel
file is large – over 8 MB. Is there a way to stop it from doing this?
Thanks for your help!


Code:
--------------------

Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "N:N"

Dim Cmnt
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Row 3 Then
If Me.Cells(.Row, "N").Value = "" Or Me.Cells(.Row, "N").Value = "O" Or Me.Cells(.Row, "N").Value = "H" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 0
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "DR" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 39
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "HJB" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 6
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "DLH" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 7
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "FDC" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 4
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "CJ" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 45
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "RT" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 20
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "GRR" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 22
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "TRG" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 54
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "GP" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 50
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "DC" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 40
End If

If Me.Cells(.Row, "N").Value = "" And Me.Cells(.Row, "O").Value = "JOINT" Then
Set Cmnt = .Comment
If Cmnt Is Nothing Then
Me.Cells(.Row, "O").AddComment
.Comment.Visible = True
.Comment.Text Text:="COG MEs:" & Chr(10)
.Comment.Shape.Select True
Else
.Comment.Visible = False
End If
End If
If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "JOINT" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 15
End If

'If Me.Cells(.Row, "O").Value = "JOINT" Then
'Set Cmnt = Me.Cells(.Row, "O").Comment
' If Cmnt Is Nothing Then
' ActiveCell(.Row, "O").AddComment
' ActiveCell(.Row, "O").Comment.Visible = True
' ActiveCell(.Row, "O").Comment.Text Text:="COG MEs:" & Chr(10)
' ActiveCell(.Row, "O").Comment.Shape.Select True
' Else
' Cmnt.Visible = False
' End If
'If Me.Cells(.Row, "N").Value = "C" And Me.Cells(.Row, "O").Value = "JOINT" Then
'Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 15
'End If
'End If

If Me.Cells(.Row, "N") = "C" Then
Me.Cells(.Row, "Q").ClearContents
End If

If Me.Cells(.Row, "N").Value = "O" Then
Me.Cells(.Row, "AS").Value = 1
Else
Me.Cells(.Row, "AS").ClearContents
End If

If Me.Cells(.Row, "N").Value = "C" Then
Me.Cells(.Row, "AT").Value = 1
Else
Me.Cells(.Row, "AT").ClearContents
End If

If Me.Cells(.Row, "O").Value = "NO ACTION" Then
Me.Cells(.Row, "N").ClearContents
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 48
End If

If Me.Cells(.Row, "N").Value = "H" And Me.Cells(.Row, "A").Value = "" Then
Me.Cells(.Row, "A").Value = Date + 30
End If

If Me.Cells(.Row, "N").Value = "O" And Me.Cells(.Row, "A").Value = "" Then
Me.Cells(.Row, "A").Value = Me.Cells(.Row, "C")
End If

End If
End With
End If

ws_exit:
Application.EnableEvents = True

If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub

On Error Resume Next
If Not Intersect(Target, Range("N:N")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
On Error GoTo 0

If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub

On Error Resume Next
If Not Intersect(Target, Range("O:O")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
On Error GoTo 0

End Sub


--------------------


--
chris46521
------------------------------------------------------------------------
chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909
View this thread: http://www.excelforum.com/showthread...hreadid=567528