Macro Speed Query

Well-known Member
Hello,

Please can you give me some advise, i have wriiten the below code which works great on my laptop but for my two fellow collegues (using identical laptops) it runs very very very slow and is unusable, can anybody tell me why this is?

Sub Result_calculation()

Application.ScreenUpdating = False

If ActiveSheet.Name = "Good Diff." Then

Range("D2").Select

Do 'insert good diff formulas
ActiveCell.FormulaR1C1 = _
"=SUMIF('Stock Holdings'!C[-3]:C[-1],RC[-3],'Stock Holdings'!C[-1])"
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=SUMIF(STR,RC[-5],'Good Stores'!C[-3])+SUMIF(WIP,RC[-5],WIP!C[-3])+SUMIF(VAN,RC[-5],Van!C[-3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=(RC[-2]+RC[-1])-RC[-3]"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],price,2,0)*RC[-1]"
ActiveCell.Offset(1, -4).Select

Loop Until IsEmpty(ActiveCell.Offset(0, -1))

End If

If ActiveSheet.Name = "Faulty Diff." Then

Range("D2").Select

Do 'insert faulty diff formulas
ActiveCell.FormulaR1C1 = _
"=SUMIF('Stock Holdings'!C[2]:C[4],RC[-3],'Stock Holdings'!C[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=SUMIF(RPS,RC[-5],'All Faulty'!C[-3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=(RC[-2]+RC[-1])-RC[-3]"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],price,2,0)*RC[-1]"
ActiveCell.Offset(1, -4).Select

Loop Until IsEmpty(ActiveCell.Offset(0, -1))

End If

'remove formulas
With Range("D2:H4000")
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
Range("A1").Select
Beep

Cheers

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a \$25,000 loan, 5% annual interest, 60 month loan.

Von Pookie

MrExcel MVP
The first thing to do would be to get rid of any "Select" statements and combine statements where possible--in short, you do not usually need to select a range in order to work with it. Other than the fact that it's not needed, it can sometimes help with macro run-time.

Also, all of that looping could be (and probably is) the issue. You're running the loop until the cell in column C is blank. If they have a lot of data in that column, it could be looping for quite some time leaving them unable to do anything while the code is running.

How about this: determine the range where the formulas should be entered, and then you could just insert them all in one go:

Code:
``````Sub Result_calculation()
Dim rngFormula As Range

Application.ScreenUpdating = False

' the range of cells where the formulas will be entered
' last row of the range is determined by the row of the first
' blank cell encountered in column C
Set rngFormula = Range("D2", Range("C2").End(xlDown).Offset(0, 5))

If ActiveSheet.Name = "Good Diff." Then
With rngFormula
' inserts formula in the first column of the range (col D)
.Columns(1).FormulaR1C1 = "=SUMIF('Stock Holdings'!C[-3]:C[-1],RC[-3],'Stock Holdings'!C[-1])"

' inserts formula in the second column of the range (col E)

' inserts formula in the third column of the range (col F)
.Columns(3).FormulaR1C1 = "=SUMIF(STR,RC[-5],'Good Stores'!C[-3])+SUMIF(WIP,RC[-5],WIP!C[-3])+SUMIF(VAN,RC[-5],Van!C[-3])"

' inserts formula in the fourth column of the range (col G)
.Columns(4).FormulaR1C1 = "=(RC[-2]+RC[-1])-RC[-3]"

' inserts formula in the fifth column of the range (col H)
.Columns(5).FormulaR1C1 = "=VLOOKUP(RC[-7],price,2,0)*RC[-1]"
End With
ElseIf ActiveSheet.Name = "Faulty Diff." Then
With rngFormula
.Columns(1).FormulaR1C1 = "=SUMIF('Stock Holdings'!C[2]:C[4],RC[-3],'Stock Holdings'!C[4])"
.Columns(3).FormulaR1C1 = "=SUMIF(RPS,RC[-5],'All Faulty'!C[-3])"
.Columns(4).FormulaR1C1 = "=(RC[-2]+RC[-1])-RC[-3]"
.Columns(5).FormulaR1C1 = "=VLOOKUP(RC[-7],price,2,0)*RC[-1]"
End With
End If

'remove formulas
With Range("D2:H4000")
.Copy
.PasteSpecial Paste:=xlValues
End With

Application.ScreenUpdating = True
Range("A1").Select
Beep

End Sub``````

Well-known Member
thank you von, i will give it a blast

Well-known Member
Dont worry i get asked that question all the time, the thing is i havent quit boxing in fact Rocky 15 comes to a screen near you later this year, i need excel to do my accounts , i cannot trust that don king fellow, you know wal i mean

Stormseed

Banned
Dont worry i get asked that question all the time, the thing is i havent quit boxing in fact Rocky 15 comes to a screen near you later this year, i need excel to do my accounts , i cannot trust that don king fellow, you know wal i mean

coool....no fret :wink:

Replies
1
Views
132
Replies
18
Views
565
Replies
3
Views
179
Replies
14
Views
319
Replies
47
Views
809

1,136,349
Messages
5,675,243
Members
419,556
Latest member
rdecker12

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back