Identifying which formulas in Excel are slowing down workbook recalaculation

It can be extremely frustrating for both those who maintain a complex workbook as well as those who have to maintain it when recalculation takes so long that it interferes with updating. Turning automatic recalculation off just leads to errors, so you really need to be able to track down the offending formulas This article will show a simple way to profile a workbook to find how long each column takes to execute.

Optimizing your workbook
As you search the Internet trying to get some insight as to why your workbook takes multiple seconds to recalaculate you will find plenty of advice about speeding up VB code, avoiding array formulas, volatile functions, sumproduct and so on. This is all good advice, but when you come to apply it its always hard to find exactly where in the workbook the problem is, and whether the incremental changes you make have actually made any difference. The best way to optimize is to find out what is taking the most time and tune it, always checking that the effect was what you intended.

Turning general advice into specific action
Do a google search on "Optimizing Excel". I got 758,000 entries when i tried it a minute ago. Most of this is good stuff, but usually you need to apply it as part of your general techniques when you are develeoping the workbook in the first place. You are reading this article because it's already too late. You didn't follow the advice, or perhaps you didn't know, or perhaps your workbook is just really complicated.

What you really want to ask is why is my spreadsheet so slow. There are 888,000 search entries for that phrase, and all of them are about someone else's spreadsheet. So let's look at how to dig into your sheet and identify which of your formulas suck the most.

What does the output look like
What we are looking to produce is a sheet that shows how long it takes to execute each column in your workbook, that will look like this. C1 is the total for all columns in seconds, and the percentage time for each column is shown below. This list will be sorted in decending order so the worst column that you need to go look at will always be at the top.


How to add to your workbook

You can download the source, and an example workbook from here

or you can workthrough the following

First create a blank tab called "ExecutionTimes", this will be where the results get posted during each profiling activity.

Now create a module, lets call it Optimize. and enter the first sub as below. This sub will run through each column of a given worksheet, timing how long each one takes, and recording the result in the executiontimes tab. The Module is also provided as an attachment to this article.

Option Explicit
Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Function timeSheet(ws As Worksheet, routput As Range) As Range
Dim ro As Range
Dim c As Range, ct As Range, rt As Range, u As Range

ws.Activate
Set u = ws.UsedRange
Set ct = u.Resize(1)
Set ro = routput

For Each c In ct.Columns
Set ro = ro.Offset(1)
Set rt = c.Resize(u.Rows.Count)
rt.Select
ro.Cells(1, 1).Value = rt.Worksheet.Name & "!" & rt.Address
ro.Cells(1, 2) = shortCalcTimer(rt, False)
Next c
Set timeSheet = ro

End Function

Sub timeallsheets()
Call timeloopSheets
End Sub

Sub timeloopSheets(Optional wsingle As Worksheet)

Dim ws As Worksheet, ro As Range, rAll As Range
Dim rKey As Range, r As Range, rSum As Range
Const where = "ExecutionTimes!a1"

Set ro = Range(where)
ro.Worksheet.Cells.ClearContents
Set rAll = ro
'headers
rAll.Cells(1, 1).Value = "address"
rAll.Cells(1, 2).Value = "time"

If wsingle Is Nothing Then
' all sheets
For Each ws In Worksheets
Set ro = timeSheet(ws, ro)
Next ws
Else
' or just a single one
Set ro = timeSheet(wsingle, ro)
End If

'now sort results, if there are any

If ro.Row > rAll.Row Then
Set rAll = rAll.Resize(ro.Row - rAll.Row + 1, 2)
Set rKey = rAll.Offset(1, 1).Resize(rAll.Rows.Count - 1, 1)
' sort highest to lowest execution time
With rAll.Worksheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rKey, _
SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal

.SetRange rAll
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' sum times
Set rSum = rAll.Cells(1, 3)
rSum.Formula = "=sum(" & rKey.Address & ")"
' %ages formulas
For Each r In rKey.Cells
r.Offset(, 1).Formula = "=" & r.Address & "/" & rSum.Address
r.Offset(, 1).NumberFormat = "0.00%"
Next r

End If
rAll.Worksheet.Activate

End Sub

Function shortCalcTimer(rt As Range, Optional bReport As Boolean = True) As Double
Dim dTime As Double
Dim sCalcType As String
Dim lCalcSave As Long
Dim bIterSave As Boolean
'
On Error GoTo Errhandl


' Save calculation settings.
lCalcSave = Application.Calculation
bIterSave = Application.Iteration
If Application.Calculation <> xlCalculationManual Then
Application.Calculation = xlCalculationManual
End If

' Switch off iteration.
If Application.Iteration <> False Then
Application.Iteration = False
End If

' Get start time.
dTime = MicroTimer
If Val(Application.Version) >= 12 Then
rt.CalculateRowMajorOrder
Else
rt.Calculate
End If


' Calc duration.
sCalcType = "Calculate " & CStr(rt.Count) & _
" Cell(s) in Selected Range: " & rt.Address
dTime = MicroTimer - dTime
On Error GoTo 0

dTime = Round(dTime, 5)
If bReport Then
MsgBox sCalcType & " " & CStr(dTime) & " Seconds"
End If

shortCalcTimer = dTime
Finish:

' Restore calculation settings.
If Application.Calculation <> lCalcSave Then
Application.Calculation = lCalcSave
End If
If Application.Iteration <> bIterSave Then
Application.Calculation = bIterSave
End If
Exit Function
Errhandl:
On Error GoTo 0
MsgBox "Unable to Calculate " & sCalcType, _
vbOKOnly + vbCritical, "CalcTimer"
GoTo Finish
End Function
'
Function MicroTimer() As Double
'

' Returns seconds.
'
Dim cyTicks1 As Currency
Static cyFrequency As Currency
'
MicroTimer = 0

' Get frequency.
If cyFrequency = 0 Then getFrequency cyFrequency

' Get ticks.
getTickCount cyTicks1

' Seconds
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function



If you do want to run on just one sheet, rather than the whole workbook you can use this, subsitituting in the worksheet name you want to analyze

Sub timeonesheet()
Call timeloopSheets(Worksheets("LIsts"))
End Sub

Summary
Once you have all this set up, assign timeallsheets() to a command button and you are good to go. I have purposefully left screenupdating on so you can see the progress - you can see it slowing down at the slow columns which is quite interesting. If necessary you can turn off screenupdating at the beginning and end of timeallsheets().

If you found this optimizer useful, you can download additional tools here for VBA profiling and optimization. The source code is included and you can use freely as you wish.







By bruce mcpherson   Popularity  (3745 Views)