Thread: Speed Testing Workbooks

The microtimer routine was taken from the MSDN Site http://msdn.microsoft.com/en-us/library/aa730921.aspx in an article by Charles Williams

I use this code a lot when testing workbooks to time functions, hope it is of some use to you!


it provides a macro

TimeSheet

Which will produce a new worksheet with timings of all formulas found in the active sheet, sorted slowest first!

and 2 functions

TimeCell(Cell,iterations)

This will return the time it took to calculate that formula note the more iterations the more acurate!

FormulaIs(Cell)

Just so I can see the formula!

PHP Code:

Option Explicit
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
Private 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
'
Function TimeCell(MyRange As Range, iterations As Integer) As Double
Application.Volatile
Dim temp As Double
Dim j As Long
Dim Temp1 As Variant

If MyRange.Formula = "" Then
    TimeCell = -1
    Exit Function
End If
temp = MicroTimer
For j = 1 To iterations
    Temp1 = Application.Evaluate(MyRange.Formula)
Next j

TimeCell = MicroTimer - temp


End Function
Function FormulaIs(MyRange) As String

    FormulaIs = MyRange.Formula

End Function
Private Function SheetExists(SheetName As String) As Boolean

Dim MySheet As Worksheet

SheetExists = False

On Error GoTo SheetExistsError
Set MySheet = Sheets(SheetName)

SheetExists = True

SheetExistsError:
On Error GoTo 0


End Function


Sub TimeSheet()

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim MySheet As Worksheet
Dim Mycell As Range
Dim TempSheet As String
Dim row As Long
Dim iterations As Integer
Dim Speed As Double

iterations = 100


TempSheet = ActiveSheet.Name

If Not SheetExists("Timings") Then

    Sheets.Add
    ActiveSheet.Name = "Timings"
   
Else
    Sheets("Timings").Activate
    Cells.Clear
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    
End If


Sheets(TempSheet).Activate

Set MySheet = ActiveSheet
 row = 1
 
For Each Mycell In MySheet.UsedRange

If Left(Mycell.Formula, 1) = "=" Then
Speed = TimeCell(Mycell, iterations) / iterations
With Sheets("Timings").Range("a1")
   .Offset(row, 1) = Mycell.Address
   
   .Offset(row, 2) = Speed
   .Offset(row, 2).NumberFormat = "0.0000000"
   
   .Offset(row, 3).Formula = "=" & Application.WorksheetFunction.Substitute(.Offset(row, 2).Address, "$", "") & "/sum(c:c)"
   .Offset(row, 3).NumberFormat = "0.0000%"
   .Offset(row, 4).Value = Len(Mycell.Formula) - 1
   .Offset(row, 5) = Right(Mycell.Formula, Len(Mycell.Formula) - 1)
End With
       row = row + 1
End If



Next
Sheets("Timings").Activate
With Range(Range("a1").Offset(1, 1), Range("a1").Offset(row - 1, 5))
        .Sort Key1:=Range("a1").Offset(0, 2), Order1:=xlDescending

End With

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub