Excel: Issue with Measuring calculation time

Question

I am trying to get a runtime on formulas for a large file (19 MB and 40 sheets) that uses a host of bad formulas.

I tried using this VBA code from the MS site to identify which formulas are causing the slowdown issues. However, I am new to VBA and this does not seem to work properly.

https://msdn.microsoft.com/en-us/vba/excel-vba/articles/excel-improving-calcuation-performance

Here is the code:

    #If VBA7 Then
        Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
            "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
        Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
             "QueryPerformanceCounter" (cyTickCount As Currency) As Long
    #Else
        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
    #End If
    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

    Sub RangeTimer()
        DoCalcTimer 1
    End Sub
    Sub SheetTimer()
        DoCalcTimer 2
    End Sub
    Sub RecalcTimer()
        DoCalcTimer 3
    End Sub
    Sub FullcalcTimer()
        DoCalcTimer 4
    End Sub

    Sub DoCalcTimer(jMethod As Long)
        Dim dTime As Double
        Dim dOvhd As Double
        Dim oRng As Range
        Dim oCell As Range
        Dim oArrRange As Range
        Dim sCalcType As String
        Dim lCalcSave As Long
        Dim bIterSave As Boolean
        '
        On Error GoTo Errhandl

    ' Initialize
        dTime = MicroTimer

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

            ' Switch off iteration.

            If Application.Iteration <> False Then
                Application.Iteration = False
            End If

            ' Max is used range.

            If Selection.Count > 1000 Then
                Set oRng = Intersect(Selection, Selection.Parent.UsedRange)
            Else
                Set oRng = Selection
            End If

            ' Include array cells outside selection.

            For Each oCell In oRng
                If oCell.HasArray Then
                    If oArrRange Is Nothing Then
                        Set oArrRange = oCell.CurrentArray
                    End If
                    If Intersect(oCell, oArrRange) Is Nothing Then
                        Set oArrRange = oCell.CurrentArray
                        Set oRng = Union(oRng, oArrRange)
                    End If
                End If
            Next oCell

            sCalcType = "Calculate " &amp; CStr(oRng.Count) &amp; _
                " Cell(s) in Selected Range: "
        Case 2
            sCalcType = "Recalculate Sheet " &amp; ActiveSheet.Name &amp; ": "
        Case 3
            sCalcType = "Recalculate open workbooks: "
        Case 4
            sCalcType = "Full Calculate open workbooks: "
        End Select

    ' Get start time.
        dTime = MicroTimer
        Select Case jMethod
        Case 1
            If Val(Application.Version) >= 12 Then
                oRng.CalculateRowMajorOrder
            Else
                oRng.Calculate
            End If
        Case 2
            ActiveSheet.Calculate
        Case 3
            Application.Calculate
        Case 4
            Application.CalculateFull
        End Select

    ' Calculate duration.
        dTime = MicroTimer - dTime
        On Error GoTo 0

        dTime = Round(dTime, 5)
        MsgBox sCalcType &amp; " " &amp; CStr(dTime) &amp; " Seconds", _
            vbOKOnly + vbInformation, "CalcTimer"

    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 Sub
    Errhandl:
        On Error GoTo 0
        MsgBox "Unable to Calculate " &amp; sCalcType, _
            vbOKOnly + vbCritical, "CalcTimer"
        GoTo Finish
    End Sub

I keep getting a syntax error. Thanks for your help!

Answer 1

Here:

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
         "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    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
#End If
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

Sub RangeTimer()
    DoCalcTimer 1
End Sub
Sub SheetTimer()
    DoCalcTimer 2
End Sub
Sub RecalcTimer()
    DoCalcTimer 3
End Sub
Sub FullcalcTimer()
    DoCalcTimer 4
End Sub

Sub DoCalcTimer(jMethod As Long)
    Dim dTime As Double
    Dim dOvhd As Double
    Dim oRng As Range
    Dim oCell As Range
    Dim oArrRange As Range
    Dim sCalcType As String
    Dim lCalcSave As Long
    Dim bIterSave As Boolean
    '
    On Error GoTo Errhandl

' Initialize
    dTime = MicroTimer

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

        ' Switch off iteration.

        If Application.Iteration <> False Then
            Application.Iteration = False
        End If

        ' Max is used range.

        If Selection.Count > 1000 Then
            Set oRng = Intersect(Selection, Selection.Parent.UsedRange)
        Else
            Set oRng = Selection
        End If

        ' Include array cells outside selection.

        For Each oCell In oRng
            If oCell.HasArray Then
                If oArrRange Is Nothing Then
                    Set oArrRange = oCell.CurrentArray
                End If
                If Intersect(oCell, oArrRange) Is Nothing Then
                    Set oArrRange = oCell.CurrentArray
                    Set oRng = Union(oRng, oArrRange)
                End If
            End If
        Next oCell

        sCalcType = "Calculate " & CStr(oRng.Count) & _
            " Cell(s) in Selected Range: "
    Case 2
        sCalcType = "Recalculate Sheet " & ActiveSheet.Name & ": "
    Case 3
        sCalcType = "Recalculate open workbooks: "
    Case 4
        sCalcType = "Full Calculate open workbooks: "
    End Select

' Get start time.
    dTime = MicroTimer
    Select Case jMethod
    Case 1
        If Val(Application.Version) >= 12 Then
            oRng.CalculateRowMajorOrder
        Else
            oRng.Calculate
        End If
    Case 2
        ActiveSheet.Calculate
    Case 3
        Application.Calculate
    Case 4
        Application.CalculateFull
    End Select

' Calculate duration.
    dTime = MicroTimer - dTime
    On Error GoTo 0

    dTime = Round(dTime, 5)
    MsgBox sCalcType & " " & CStr(dTime) & " Seconds", _
        vbOKOnly + vbInformation, "CalcTimer"

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 Sub
Errhandl:
    On Error GoTo 0
    MsgBox "Unable to Calculate " & sCalcType, _
        vbOKOnly + vbCritical, "CalcTimer"
    GoTo Finish
End Sub