Excel: Issue with Measuring calculation time

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!

1 answer

  • answered 2018-03-13 21:57 ashleedawg

    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