LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Code to replace 'sumproduct'


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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
sumproduct replace with sumif avk Excel Discussion (Misc queries) 0 January 12th 11 07:22 PM
Replace SUMIF with SUMPRODUCT torooo Excel Discussion (Misc queries) 3 December 10th 07 06:33 PM
Replace SUMIF with SUMPRODUCT torooo Excel Worksheet Functions 14 December 8th 07 11:25 PM
Replace code ALC Excel Programming 2 July 19th 05 07:30 PM
Replace Code Programmatically Datasort Excel Programming 3 January 26th 05 05:15 PM


All times are GMT +1. The time now is 06:39 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"