Identifying Recalculation Bottlenecks

Here's a function that returns the time to calculate a Target range of cells. The result is in milliseconds with microsecond resolution. Optional parameter NumToAverage permits averaging to reduce operating system vagaries (which persist anyway); default is 1 to skip averaging. If optional parameter UpdateScreen is TRUE, the screen will update while Target is calculated; default is FALSE to prevent screen updating. This VBA should be located at the beginning of a standard module.

Option Explicit

'NOTE: LongLong applies only to 64-bit Excel.
'Change ALL LongLong to Currency for 32-bit Excel.
'Currency can also be used with 64-bit Excel.

Private Declare PtrSafe Function QueryPerformanceCounter _
    Lib "kernel32" (lpPerformanceCount As LongLong) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency _
    Lib "kernel32" (lpFrequency As LongLong) As Long

Private Function MsecToCalculate(Target As Range, _
    Optional NumToAverage As Integer = 1, _
    Optional UpdateScreen As Boolean = False) As Double
    Dim bUpda As Boolean, nCalc As Integer, n As Integer
    Dim tBeg As LongLong, tEnd As LongLong, tSum As LongLong
    Static tFreq As LongLong
    If tFreq = 0 Then QueryPerformanceFrequency tFreq
    With Application
        bUpda = .ScreenUpdating
        .ScreenUpdating = UpdateScreen
        nCalc = .Calculation
        .Calculation = xlCalculationAutomatic
        For n = 1 To NumToAverage
            QueryPerformanceCounter tBeg
            Target.Dirty 'forces recalc when mode is automatic
            QueryPerformanceCounter tEnd
            tSum = tSum + tEnd - tBeg
        Next n
        .ScreenUpdating = bUpda
        .Calculation = nCalc
    End With
    MsecToCalculate = Round(1000 * tSum / tFreq / NumToAverage, 3)
End Function

Here are some example macros that determine the time to calculate the current selection, the active worksheet, or all worksheets in the active workbook. Results appear in the VB Editor's immediate window. This VBA must be in the same module as the previous VBA.

Sub BenchmarkSelection()
    Debug.Print MsecToCalculate(Selection)
End Sub

Sub BenchmarkActiveSheet()
    Debug.Print MsecToCalculate(ActiveSheet.UsedRange)
End Sub

Sub BenchmarkWorkbook()
    Dim ws As Worksheet, msec As Double, sum As Double
    For Each ws In Worksheets
        msec = MsecToCalculate(ws.UsedRange)
        sum = sum + msec
        Debug.Print ws.Name, msec, sum
    Next ws
End Sub

Hi Allen, glad to read your notes you're fine in your new warm corner of the world. And, speaking of good news, I would like tu suggest you include MS Excel Latest News and MS Word Latest News, even MS Windows Latest News in your set of week tools. It would be great bonus of information about MS software latest improvements. Thanks for your attention.

Or you could simply ask Gemini (or other A.I. tool) to identify the bottlenecks.