Speed up calcs within macro....

[Matt Knight]

This started off over in microsoft.public.excel:
http://groups.google.com/group/microsoft.public.excel/browse_thread/thread/a9a5ee1032d2925c

Basically I was using a really inefficient macro to run some calcs and
paste in values to restrict file size. Luckily, Otto kindly managed
to sort out some more efficient code, but as there are still 172,000
calcs, so obviously they take some time (on the machine I need tom to
work well on, they take about 9mins). Here's the latest code I'm
using:

Sub driver_calc()
Application.ScreenUpdating = False
Dim myLC As Long
Dim myLR As Long
Dim myLRr As Long
Dim myLCr As Long
Dim ws As Worksheet
Dim TheFormula As String

Const Formula1 = "=if(sumproduct(--('Course List by division'!$c
$6:$C$607=E$4),'Course List by division'!$i$6:$i$607)=0,0,sumproduct(--
('Course List by division'!$E$6:$e$607=$b6),--('Course List by
division'!$c$6:$c$607=E$4),'Course List by division'!$i$6:$i$607)/
sumproduct(--('Course List by division'!$c$6:$c$607=E$4),'Course List
by division'!$i$6:$i$607))"

Const Formula2 = "=if(sumproduct(--('Course List by division'!$c
$6:$C$607=E$4),'Course List by division'!$j$6:$j$607)=0,0,sumproduct(--
('Course List by division'!$E$6:$e$607=$b6),--('Course List by
division'!$c$6:$c$607=E$4),'Course List by division'!$j$6:$j$607)/
sumproduct(--('Course List by division'!$c$6:$c$607=E$4),'Course List
by division'!$j$6:$j$607))"

Const Formula3 = "=if(sumproduct(--('Course List by division'!$c
$6:$C$607=E$4),'Course List by division'!$k$6:$k$607)=0,0,sumproduct(--
('Course List by division'!$E$6:$e$607=$b6),--('Course List by
division'!$c$6:$c$607=E$4),'Course List by division'!$k$6:$k$607)/
sumproduct(--('Course List by division'!$c$6:$c$607=E$4),'Course List
by division'!$k$6:$k$607))"

For Each ws In Sheets(Array("Driver 1 - STUDENTS", "Driver 2 -
TIME", "Driver 3 - STUDENTSxTIME"))
With ws
Application.Calculation = xlCalculationManual
myLC = .Range("IV4").End(xlToLeft).Column
myLR = .Cells(Rows.Count, "C").End(xlUp).Row
myLCr = .Range("IV6").End(xlToLeft).Column
myLRr = .Cells(Rows.Count, "E").End(xlUp).Row
.Range("E6", .Cells(myLR, myLC)).ClearContents
Select Case ws.Name
Case "Driver 1 - STUDENTS": TheFormula = Formula1
Case "Driver 2 - TIME": TheFormula = Formula2
Case "Driver 3 - STUDENTSxTIME": TheFormula = Formula3
End Select
.Range("E6").Formula = TheFormula
.Range("E6").Copy .Range("E6", .Cells(myLR, myLC))
Application.Calculation = xlCalculationAutomatic
.Range("E6", .Cells(myLR, myLC)).Copy
.Range("E6").PasteSpecial Paste:=xlPasteValues
.Application.CutCopyMode = False
End With
Next ws
MsgBox "Drivers succesfully updated", vbInformation,
"Lxxxxxxxxxxxxx"
End Sub

I was wandering if there was a better way of using the formulae rather
than getting Excel to do them "on the fly". FYI, I'm using Excel 2003
on XP, but the client I'm doing this for uses Excel 2007 on XP, so
getting superfast on 03 isn't essential.

If anyone can offer any advice.guidance I'd massively appreciate it!

Cheers
Matt

 

[Gary Keramidas]

just a thought, not sure what it would do because i don't know all of the
implications, but maybe just calculating the relevant cells instead of global
recalc. then turn calculation back on at the end, instead of the end of every
loop.

 

[Matt Knight]

Hi Gary,

Thanks for the response - I'm not sure that doing what you've
suggested would have a massive impact, unless I've misunderstood what
you mean. Seeing as I have to calculate 172000 fairly complex
formulas, would it make much of a difference as to when the calcs are
done?

Matt

 

[Martin Brown]

This started off over in microsoft.public.excel:
http://groups.google.com/group/microsoft.public.excel/browse_thread/thread/a9a5ee1032d2925c

Basically I was using a really inefficient macro to run some calcs and
paste in values to restrict file size. Luckily, Otto kindly managed
to sort out some more efficient code, but as there are still 172,000
calcs, so obviously they take some time (on the machine I need tom to
work well on, they take about 9mins). Here's the latest code I'm
using:

You might get some mileage by factoring out common terms and working
them out using VBA Application.WorksheetFunction.SumProduct()
It looks like you are enabling recalculation inside the inner loop which
will definitely hurt performance.

Different ways of indexing ranges have noticeably different overheads so
it is worth experimenting. The form you have chosen may be one of the
slower variants. Again it might be worth trying working on an explicit
memory array copy and copying the final numbers back to the spreadsheet.

BTW your long constant formulae are a maintainence trap with three
nearly identical versions differing in tiny ways. You should simplify
them to one common expression with the differences made explicit.

Regards,
Martin Brown

 

[Matt Knight]

Hi Martin, thanks a lot for your reply.

As I'm fairly new to the whole VBA game, I don't think I could say
that I was proficient to add things to people's code (rather I can
copy it and make it work on whatever I'm working on!). Any quick
hints and I reckon I should be okay to get experimenting, but the
last thing I want to do is to start messing up the code!

Matt

 

[Matt Knight]

Thanks Joel - really appreciate it. I'll have a play around now and
see what happens!

Matt

 

[Matt Knight]

My apologies for the radio silence on this - been busy on other jobs
with limited internet connectivity.

But rest assured myself and a colleague have been scratching our heads
over this for the last week on and off. We've essentially merged a
few of the methods that have been suggested and are just trying to
iron out some small problems. Hopefully we'll have cracked it by the
end of today. EIther way I'll keep you posted and post the final
solution for anyone else to steal.

Matt

Thanks Joel - really appreciate it.  I'll have a play around now and
see what happens!

Matt

Sumproduct formulas are known to slow down a workbook considerable.
Putting ther formula into VBA the way you did doesn't change the speed.
what you can do is replace the formula with a value.  You can use the
evaluate method in ?VBA like this

Formula1 = "if(sumproduct(--('Course List by division'!$c
$6:$C$607=E$4),'Course List by
division'!$i$6:$i$607)=0,0,sumproduct(--
('Course List by division'!$E$6:$e$607=$b6),--('Course List by
division'!$c$6:$c$607=E$4),'Course List by division'!$i$6:$i$607)/
sumproduct(--('Course List by division'!$c$6:$c$607=E$4),'Course List
by division'!$i$6:$i$607))"
Results = Evaluate(formula1)

The evaluate still takes the same amount of time to execute as putting
the formula in the worksheet but the calculation is only performed once,
not every time the workbook is updated.

All I did was to remove the equal sign from you formula and added
parenthesis around you code.

you had
Formula1 = "=........."

I replaced it with
Formula1 = "........."

Results = evaluate(Formula1)

to make you formula more versitile what I do is add ranges like this

with sheets("Course List by division'")

Set MyRange1 = .Range("$C6:$C$607")
MyRangeAddr1 = MyRange1.address(external:=true)

Set MyRange2 = .Range("$I6:$I$607")
MyRangeAddr2 = MyRange2.address(external:=true)

Set MyRange3 = .Range("$E6:$E$607")
MyRangeAddr3 = MyRange3.address(external:=true)

Set MyRange4 = .Range("$J6:$J$607")
MyRangeAddr4 = MyRange3.address(external:=true)

Formula1 = "if(sumproduct(--(" & MyRangeAddr4 & "=E$4)," & _
"--(" & MyRangeAddr2 & "=0,0," &
_
"sumproduct(--(" & MyRangeAddr3 & "=$b6)," & _
"--(" & MyrangeAddr1 & "=E$4)," &
_
MyRangeAddr2 & ")/" &
_
"sumproduct(--(" & MyRangeAddr1 & "=E$4)," & _
MyRangeAddr2 & "))"

I didn't test my changes but they should be close.

Microsoft Office Help- Hide quoted text -

- Show quoted text -

 

[Matt Knight]

Right, this is the first part of the code we've been trying to get to
work:

Sub driver_calc()

Application.ScreenUpdating = False

Dim myLC As Long
Dim myLR As Long
Dim myLRr As Long
Dim myLCr As Long

Sheets("Driver 1 - STUDENTS").Select

With Sheets("Driver 1 - STUDENTS")
Application.Calculation = xlCalculationManual
myLC = .Range("IV4").End(xlToLeft).Column
myLR = .Cells(Rows.Count, "B").End(xlUp).Row
myLCr = .Range("IV5").End(xlToLeft).Column
myLRr = .Cells(Rows.Count, "C").End(xlUp).Row
.Range("e6", .Cells(myLRr, myLCr)).ClearContents

Set MyRange1 = .Range("B5:B" & myLR)
MyRangeAddr1 = MyRange1.Address(external:=True)

Set MyRange2 = .Range("C4", .Cells(4, myLC))
MyRangeAddr2 = MyRange2.Address(external:=True)

End With

Formula1 = "if(sumproduct(--('Course List by division'!$c$6:$C
$607=" & MyRangeAddr2 & "),'Course List by division'!$i$6:$i$607)
=0,0,sumproduct(--('Course List by division'!$E$6:$e$607=" &
MyRangeAddr1 & "),--('Course List by division'!$c$6:$c$607=" &
MyRangeAddr2 & "),'Course List by division'!$i$6:$i$607)/sumproduct(--
('Course List by division'!$c$6:$c$607=" & MyRangeAddr1 & "),'Course
List by division'!$i$6:$i$607))"

'"" & MyRangeAddr1 & " * " & MyRangeAddr2 & ""

Result1 = Evaluate(Formula1)

Sheets("Driver 1 - STUDENTS").Range("c5", Cells(myLR,
myLC)).Formula = Result1



The issue we're having is that we get an error 2015 producing
"#VALUE!" in all the cells in Excel. Have seen a couple fo examples
of 2015s elsewhere on this group but not figured out a solution to
this problem (if there is one?!)

Cheers
Matt