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.