Which formula is faster how to identify

[Abhijeet]

Hi

I want to identify which formula is faster i found code but any one can tell me how to use & identify please tell me

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
'
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

' Calc 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

 

[Hui]

It is typical when doing these type of tests to run the calculation over a large number of cells say 100,000
then divide the time by 100,000
Then run the test repeatedly for several times and average the results
This eliminates system interference with the timing and use of the CPU
Also shut all applications, especially Internet Browsers and minimise Mouse use whilst the code is running

Using the above modified code

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
'
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 DoCalcTimer()
  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.
  If Application.Calculation <> xlCalculationManual Then
  Application.Calculation = xlCalculationManual
  End If
  
'Start Timer
  dTime = MicroTimer
  
  'Put Your Function here
  [A1:A100000].Formula = "=VLOOKUP(1, B$2:C$10,2)"

  'Application.Calculation = xlCalculationAutomatic
  Application.CalculateFull

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

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

Finish:

  ' Restore calculation settings.
  Application.Calculation = xlCalculationAutomatic
  Exit Sub
Errhandl:
  On Error GoTo 0
  MsgBox "Unable to Calculate " & sCalcType, _
  vbOKOnly + vbCritical, "CalcTimer"
  GoTo Finish
End Sub

Sub RangeTimer()
  DoCalcTimer
End Sub

Copy all the code into a Code Module in VBA
Then save the file

Edit the function in the line to match your requirements
[A1:A100000].Formula = "=VLOOKUP(1, B$2:C$10,2)"

Then simply click inside the Sub RangeTimer and press F5

 

[Abhijeet]

macro not work error show in this code

Sub RangeTimer()
  DoCalcTimer
End Sub

 

[Hui]

If you don't have a 64 bit version of excel change the first 2 lines to:

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

ie: remove the words Ptrsafe from both lines

 

[Hui]

Whoops

Change the line:
Sub DoCalcTimer(jMethod As Long)

to:
Sub DoCalcTimer()

Refer Attached file:

 

[Abhijeet]

Tell me each time run macro then change value so how many time run the macro & average it that

 

[Hui]

Each time you run it it will give you an answer in seconds say 5.8 seconds
But that is for 100,000 iterations of the function, so the time per function is =5.8/100000

But I would do that 3 or 4 times and make sure the averages of each run are similar eg: 5.8

If they are 5.8, 10, 3 that means your PC is doing other work
If they are all 5.8, 5.81, 5.78 etc you know that is probably the answer