Execution Time Logging

Sometimes recalculation seems to take a long time and you cant find the formula that is slowing it all down. The advice you find is usually generic, telling you that function X() is slow etc, but what you really want to do is find out which cells in your sheet are taking a long time. Here are some modules to help you do that. OptimizeExample.xlsm is  a downloadable working example here, or you can follow along with the development below

Lets say that you have a large complex worksheet, and it is so slow that you have to turn off automatic calculation to make it usable. Well if thats the case, its already not really usable. To optmize your workbook, the first  thing is to find which calculations are actually taking a long time. So what we are going to do here is create something that tells you the execution time of every single column in your workbook and creates a log so you can see the columns that take the most time.

The output is going to look something like this - showing how long it took to execute the formulas in each column of your workbook.

2. Now create a module called Optimize, and insert the following Sub.

This code is available from optimizeExample.xlsm in the downloads section.

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

This is our main function that will be called for each Sheet in your workbook. Starting at the place identified by the range routput, it will report on the address of each column in the sheet ws, along with how long it took to calculate each formula in seconds.

3. Now insert the following subs which will reference this.

 Sub timeallsheets()    Call timeloopSheetsEnd SubSub 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.ActivateEnd Sub

4. Insert the code for timing the calculation.

shortCalcTimer() is called from
timeSheet()
for each column in the sheet. This is based on a module I found on a microsoft website  and seems to work quite well in that it is more granular than the usual vba timer functions. Acknowledgement for the original version of the microtimer to Charles Williams, Decision Models Limited

At the top of your Optimize module enter this

 Option ExplicitPrivate Declare Function getFrequency Lib "kernel32" _Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As LongPrivate Declare Function getTickCount Lib "kernel32" _Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

and finally,

 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 = dTimeFinish:    ' Restore calculation settings.    If Application.Calculation <> lCalcSave Then         Application.Calculation = lCalcSave    End If    If Application.Iteration <> bIterSave Then         Application.Calculation = bIterSave    End If    Exit FunctionErrhandl:    On Error GoTo 0    MsgBox "Unable to Calculate " & sCalcType, _        vbOKOnly + vbCritical, "CalcTimer"    GoTo FinishEnd 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 / cyFrequencyEnd Function

All Done...

The sub you will execute is timeallsheets. If you like, create a command button in your workbook and associate it with that, otherwise just run it as is.

Finally ...

If you want to just analyze a single sheet, then use this code, substituting in the name of the sheet you want to analyze, or just download a working example

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