excel 365 64 bits profiler

[fabiocs8]

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 = rffset(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

 

[i_nth]

To run in a 64 bit environment, you just need to add

PtrSafe

to the function declarations.
That is:

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

 

[fabiocs8]

Thank you very much, saved my day.