05-20-2009, 03:39 AM
|
 |
Valued Forum Contributor
|
|
Join Date: 17 Feb 2009
Location: Littleborough, UK
MS Office Version:Excel 3.0 to 2007+2010! (couldnt get 2.1 working)
Posts: 457
|
|
|
Speed Testing Workbooks
Please Register to Remove these Ads
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
__________________
 No longer looking for work (still if you want to pay me lots of money lets talk!!!)
If you are happy with the results, please add to our reputation by clicking the blue scales icon in the blue bar of the post.
We've all heard that a million monkeys banging on a million typewriters will eventually reproduce the entire works of Shakespeare............
Now, thanks to the Internet, we know this is not true.
Robert Wilenski (since there is some confusion I am not Robert he wrote the quote!)
Last edited by squiggler47; 05-20-2009 at 06:34 AM.
|
Linear Mode
