Code to replace 'sumproduct'

C

chris46521

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
 
B

Bob Phillips

You could try turning calculation off in the event code

Application.Calculate = xlCalculationManual

and reset again at the end to xlCalculationAutomatic

Then you could replace SP with formulae than look at less cells. Which cell
is that in, and where is the next SP and what does it look like?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

chris46521 said:
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
Click to expand...
Me.Cells(.Row, "O").Value = "H" Then
 
G

Guest

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
 
C

chris46521

I get a compile error when I insert the Application.Calculate
xlCalculationManual code. It says "Expected function or variable."
have tried placing it in various location, but I still cannot get th
compiler to accept it. Should that code be placed at the beginning an
end of each event code? Thanks so much for your help!
 
G

Guest

Yup. Something like this...

Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------

Const WS_RANGE As String = "O:O"
Application.EnableEvents = True
Application.Calculation = xlCalculationManual 'Here*********

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
Application.Calculation = xlCalculationAutomatic 'And Here*********

End Sub
 
B

Bob Phillips

Got my calculate and calculation back to front


Application.Calculation = xlCalculationManual

and


Application.Calculation = xlCalculationAutomatic

what about the formulae?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
D

David F. Cox

I should not be posting, I am trying to "get back onthe horse" after a few
years layoff, but ...

You only need to calculate most of the tests like . " If Me.Cells(.Row,
"O").Value = "C" " once.

I suggest that you try rewriting the code, with if and else if you prefer or
with Select .. case statements, along the lines of:-

Select Me.Cells(.Row, "O").Value
case "C"
select case Me.Cells(.Row, "P").Value
case "DR" ....
case "HJB" ....

.......
case else ...
end select
case "O" ....
select case Me.Cells(.Row, "M").Value
......
case else

end select
etc

You should find that you need far fewer "Me.Cells(.Row, "A").Resize(,
26).Interior.ColorIndex = " statements as a result too.


It might help you to draw a little flowchart. (do I lose points for
mentioning flowchart these days?)

David F. Cox
 
C

chris46521

Thanks for your help David! I will try to rewrite my code in that manner
and make a flowchart to help me see how it should work. Do you think my
sumproduct is causing my spreadsheet to be so slow when calculating
cells? If so, I need to come up with code to replace the sumproduct
formulae. Do you have any suggestions? Thanks so much for your help!
 
C

chris46521

Thanks for your help Bill. That improved the speed a little bit. I'm not
sure if SP is the cause of my sheet being so slow. I guess it would be
best to replace the sumproduct formulae with code. It would follow the
same logic as the SP formula:

=SUMPRODUCT(--($B$4:$B$1002<=B4),--($M$4:$M$1002="PROD"),--($O$4:$O$1002="O"))

Would you know of a way that I might go about doing this? Thanks again
for your help.
 
B

Bob Phillips

Who's Bill?

I think you should explore improving the SP before going to code. Code can
be better in some cases, but it is inherently slower than built-in
functionality, so you have to use a different technique to get the speed
improvements. You can usually make a big difference with rewriting the
formulae.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
C

chris46521

Thanks for the info Bob. How would you suggest that I change SP? Is
there a more efficient way of using a different formula than SP?
Thanks!
 
B

Bob Phillips

Give me an assist. As I previously asked ... Then you could replace SP with
formulae than look at less cells. Which cell
is that in, and where is the next SP and what does it look like?


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
C

chris46521

I'm not sure exactly what you mean when you say, "...Then you could
replace SP with formulae than look at less cells. Which cell is that
in, and where is the next SP and what does it look like?" The formula,
=SUMPRODUCT(--($B$4:$B$1002<=B4),--($M$4:$M$1002="PROD"),--($O$4:$O$1002="O"))
repeats all the way down two separate column from rows 4 to 1002. As you
can see, the only part of it that is dynamic is in red.

The formula looks at cloumn B to see if the date is less than or equal
to the date of the current row in column B (there may be multiple dates
that are the same). Then it looks at column M to see how PROD's are
listed for that date. Finally it looks at column O to see how many O's
are listed for the previous conditions. SP then returns the sum of
these where the conditions are met in all three columns. Was this what
you were asking? Thanks for your help!
 
B

Bob Phillips

Can the data be sorted into date order in B4:B1002?

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
D

David F. Cox

I do not know if there is a better answer than using the sumproduct
function. I would have to play with your spreadsheet to find out where, if
anywhere, you are getting a performance hit. My boss and mentor castigated
me for "optimising" some code saying "The computer is there to make your
life easier, you are not there to make its life easier." Subsequent
experience has taught me that complicating simple tasks to make them run
quicker is too often counter-productive, and sometimes surprisingly
unsuccessful.OTOH sometimes a bit of thought and a small tweak can have
amazing results.
I would not have suggested that you rewrote your code if I did not believe
that the end result would be more concise, understandable and maintainable
code, as well as hopefully, being quicker.

good luck.

David F. Cox
 
C

chris46521

Yes, the dates are already sorted in ascending order, although there are
many duplicate dates. Thanks for the help you have given me on this.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Code stopped working 2
Problem of With Target/End With block 4
COMBINE TWO MACROS INTO ONE 10
HOW TO MIX TWO MACRO CODES 2
CORRECTION NEEDED 2
Help with this code 9
CAN ANYONE PLEASE SOLVE MY PROBLEM 1
MACRO IS NOT COMPLETE 2

Top