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/enus/vba/excelvba/articles/excelimprovingcalcuationperformance
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 " & 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
I keep getting a syntax error. Thanks for your help!
1 answer

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