My spreadsheet is slow 'calculating cells,' I think due to the
SUMPRODUCT function I have in a couple of columns, but I’m not sure if
it’s the culprit. I was wondering if there is a way to replace
sumproduct with code that might make my sheet not take so long to
calculate cells. Here is one of the sumproduct formulas that I am
using. It is for about 1000 rows in two columns.
Code:
--------------------
=SUMPRODUCT(--($B$4:$B$1002<=B4),--($M$4:$M$1002="PROD"),--($O$4:$O$1002="O"))
--------------------
Also here is the code for my sheet. I’m not sure if anything in here is
causing it to be slow calculating. Thanks for your help!
Code:
--------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O:O"
Application.EnableEvents = True
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
'Begin coloring row ranges based on these requirements
If .Row 3 Then
If Me.Cells(.Row, "O").Value = "" Or Me.Cells(.Row, "O").Value = "O" Or Me.Cells(.Row, "O").Value = "H" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 0
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DR" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 39
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "HJB" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 6
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DLH" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 7
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "FDC" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 4
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "CJ" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 45
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "RT" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 20
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "GRR" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 22
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "TRG" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 54
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "GP" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 50
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DC" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 40
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "JOINT" Then
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 15
End If
'Clear Std Hours
If Me.Cells(.Row, "O") = "C" Then
Me.Cells(.Row, "R").ClearContents
End If
'Placing "1's" in columns based on these requirments
If Me.Cells(.Row, "O").Value = "O" And Me.Cells(.Row, "M").Value = "PROD" Then
Me.Cells(.Row, "AA").Value = 1
Else
Me.Cells(.Row, "AA").ClearContents
End If
If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "M").Value = "PROD" Then
Me.Cells(.Row, "AB").Value = 1
Else
Me.Cells(.Row, "AB").ClearContents
End If
If Not Me.Cells(.Row, "O").Value = "O" And Not Me.Cells(.Row, "M").Value = "PROD" Then
Me.Cells(.Row, "AE").Value = 1
Else
Me.Cells(.Row, "AE").ClearContents
End If
If Not Me.Cells(.Row, "O").Value = "C" And Not Me.Cells(.Row, "M").Value = "PROD" Then
Me.Cells(.Row, "AF").Value = 1
Else
Me.Cells(.Row, "AF").ClearContents
End If
If Me.Cells(.Row, "P").Value = "NO ACTION" Then
Me.Cells(.Row, "O").ClearContents
Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 48
End If
If Me.Cells(.Row, "O").Value = "H" And Me.Cells(.Row, "A").Value = "" Then
Me.Cells(.Row, "A").Value = Date + 30
End If
If Me.Cells(.Row, "O").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
'Force upper case on text in columns O and P
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
If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("P:P")) 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=569999