View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Jim Thomlinson Jim Thomlinson is offline
external usenet poster
 
Posts: 5,939
Default Code to replace 'sumproduct'

As a general rule built in functions in Excel will be faster than any code
that you can write. I have my doubts that your sumproduct can be replaced
easily and even greater doubts that it will get you any kind of a performance
increase. The one thing I notice in our code is that you do not toggle
calculations off will the code is running. That could get you a reasonable
performance increase...

Application.Calculation = xlManual
'Your code
Application.Calculation = xlAutomatic

--
HTH...

Jim Thomlinson


"chris46521" wrote:


My spreadsheet is slow 'calculating cells,' I think due to the
SUMPRODUCT function I have in a couple of columns, but Im not sure if
its 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. Im 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