excel 365 64 bits profiler

fabiocs8

New Member
Joined
May 29, 2014
Messages
2
Hi all,

I have a workbook that became very slow. I would like to use a profiler to help me spot where it slows down. I got some VBA code (please see below), but all it is for 32 bits Excel, that s asks for 64-bit in the first 4 lines. Because I am beginner I can´t fix it.

Does someone know how to fix it? On the other hand, would someone have a reference ob a VBA code / tool that would help me in this platform?
Thanks in advance, fabio.

Code below:

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


Function timeSheet(ws As Worksheet, routput As Range) As Range
Dim ro As Range
Dim c As Range, ct As Range, rt As Range, u As Range


ws.Activate
Set u = ws.UsedRange
Set ct = u.Resize(1)
Set ro = routput


For Each c In ct.Columns
Set ro = ro_Offset(1)
Set rt = c.Resize(u.Rows.Count)
rt.Select
ro.Cells(1, 1).Value = rt.Worksheet.Name & "!" & rt.Address
ro.Cells(1, 2) = shortCalcTimer(rt, False)
Next c
Set timeSheet = ro


End Function


Sub timeallsheets()
Call timeloopSheets
End Sub


Sub timeloopSheets(Optional wsingle As Worksheet)


Dim ws As Worksheet, ro As Range, rAll As Range
Dim rKey As Range, r As Range, rSum As Range
Const where = "ExecutionTimes!a1"


Set ro = Range(where)
ro.Worksheet.Cells.ClearContents
Set rAll = ro
'headers
rAll.Cells(1, 1).Value = "address"
rAll.Cells(1, 2).Value = "time"


If wsingle Is Nothing Then
' all sheets
For Each ws In Worksheets
Set ro = timeSheet(ws, ro)
Next ws
Else
' or just a single one
Set ro = timeSheet(wsingle, ro)
End If


'now sort results, if there are any


If ro.Row > rAll.Row Then
Set rAll = rAll.Resize(ro.Row - rAll.Row + 1, 2)
Set rKey = rAll.Offset(1, 1).Resize(rAll.Rows.Count - 1, 1)
' sort highest to lowest execution time
With rAll.Worksheet.Sort
.SortFields.Clear


.SortFields.Add Key:=rKey, _
SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal


.SetRange rAll
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' sum times
Set rSum = rAll.Cells(1, 3)
rSum.Formula = "=sum(" & rKey.Address & ")"
' %ages formulas
For Each r In rKey.Cells
r.Offset(, 1).Formula = "=" & r.Address & "/" & rSum.Address
r.Offset(, 1).NumberFormat = "0.00%"
Next r


End If
rAll.Worksheet.Activate


End Sub


Function shortCalcTimer(rt As Range, Optional bReport As Boolean = True) As Double
Dim dTime As Double
Dim sCalcType As String
Dim lCalcSave As Long
Dim bIterSave As Boolean
'
On Error GoTo Errhandl




' Save calculation settings.
lCalcSave = Application.Calculation
bIterSave = Application.Iteration
If Application.Calculation <> xlCalculationManual Then
Application.Calculation = xlCalculationManual
End If


' Switch off iteration.
If Application.Iteration <> False Then
Application.Iteration = False
End If


' Get start time.
dTime = MicroTimer
If Val(Application.Version) >= 12 Then
rt.CalculateRowMajorOrder
Else
rt.Calculate
End If




' Calc duration.
sCalcType = "Calculate " & CStr(rt.Count) & _
" Cell(s) in Selected Range: " & rt.Address
dTime = MicroTimer - dTime
On Error GoTo 0


dTime = Round(dTime, 5)
If bReport Then
MsgBox sCalcType & " " & CStr(dTime) & " Seconds"
End If


shortCalcTimer = dTime


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 Function
Errhandl:
On Error GoTo 0
MsgBox "Unable to Calculate " & sCalcType, _
vbOKOnly + vbCritical, "CalcTimer"
GoTo Finish


End Function
'
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
 
Last edited:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
To run in a 64 bit environment, you just need to add
Code:
PtrSafe
to the function declarations.
That is:
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
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top