I have created an excel VBA macro with does a lot of data intensive processing. I make a lot of use of Collections. On some PCs it runs very fast, and on others it runs very slow. I have isolated the problem in the example code below. Please note that the example code is not an functional program, it is just to isolate the technical problem I encounter in the bigger program.
I have tested the macro on 4 different machines. See below the output with the CPU info, all use “Microsoft® Excel® for Microsoft 365 MSO (Version 2210 Build 16.0.15726.20188) 32-bit”:
Intel(R) Core(TM) i9-10900K CPU # 3.70GHz, RAM 16.0 GB:
Run loop took 0.09 seconds. Clearing memory took 0.04 seconds.
11th Gen Intel(R) Core(TM) i7-1185G7 # 3.00GHz, RAM 16,0 GB:
Run loop took 0,10 seconds. Clearing memory took 0,05 seconds.
Intel(R) Core(TM) i7-7700K CPU # 4.20GHz, RAM 32,0 GB:
Run loop took 162,58 seconds. Clearing memory took 5,48 seconds.
Intel(R) Core(TM) i7-8665U CPU # 1.90GHz, RAM 16.0 GB:
Run loop took 201,03 seconds. Clearing memory took 6,37 seconds.
Code of the VBA procedure:
Option Explicit
Sub largeCollection()
Dim time1 As Single
Dim time2 As Single
time1 = Timer
Dim myCollection As New Collection
Dim I As Long
Dim aClass1 As Class1
For I = 2 To 50000
Set aClass1 = New Class1
aClass1.d1 = I
aClass1.d2 = I
aClass1.d3 = I
aClass1.d4 = I
aClass1.d5 = I
aClass1.d6 = I
aClass1.d7 = I
aClass1.d8 = I
aClass1.d9 = I
aClass1.d10 = I
aClass1.i1 = I
aClass1.i2 = I
aClass1.i3 = I
aClass1.i4 = I
aClass1.i5 = I
aClass1.i6 = I
aClass1.i7 = I
aClass1.i8 = I
aClass1.i9 = I
aClass1.i10 = I
myCollection.Add aClass1
Next I
time2 = Timer
Set myCollection = Nothing
'Notify user in seconds
Debug.Print "Run loop took " & Format((time2 - time1), "0.00") & " seconds. Clearing memory took " & Format((Timer - time2), "0.00") & " seconds."
End Sub
Code of the custom class "Class1":
Option Explicit
Public s1 As String
Public s2 As String
Public s3 As String
Public s4 As String
Public s5 As String
Public s6 As String
Public s7 As String
Public s8 As String
Public s9 As String
Public s10 As String
Public s11 As String
Public s12 As String
Public s13 As String
Public s14 As String
Public s15 As String
Public s16 As String
Public s17 As String
Public s18 As String
Public s19 As String
Public s20 As String
Public v1 As Variant
Public v2 As Variant
Public v3 As Variant
Public v4 As Variant
Public v5 As Variant
Public v6 As Variant
Public v7 As Variant
Public v8 As Variant
Public v9 As Variant
Public v10 As Variant
Public i1 As Long
Public i2 As Long
Public i3 As Long
Public i4 As Long
Public i5 As Long
Public i6 As Long
Public i7 As Long
Public i8 As Long
Public i9 As Long
Public i10 As Long
Public d1 As Double
Public d2 As Double
Public d3 As Double
Public d4 As Double
Public d5 As Double
Public d6 As Double
Public d7 As Double
Public d8 As Double
Public d9 As Double
Public d10 As Double
I am running out of options, it would be great if anyone can provide a solution.
We finally have found an answer ourselves, although it is not very comforting... The difference in performance seems to be completely dependent on the trust center macro settings.
If I select the option:
"Disable macros with notification", I have to explicitly "enable content" to enable the macros when I open the workbook. Using this option the macro runs 2000 times slower
"Enable VBA macros (not recommended; potentially dangerous code can run)" the code runs 2000 times faster.
I would expect the 2 options to have the same performance since after I have enabled the content, I have enabled the VBA macros, just as if I would have selected the other option.
This would mean that the only way I can have a performant macro, is to set the option to "Enable VBA macros (not recommended; potentially dangerous code can run)", which would result in all macros for all workbooks being run by default, even if I would open a random excel from a 3rd party, which is a huge security risk.
in Class1 there are a lot of variables, many of them as Variant which requires more memory space. Try to create new collections in the class1 to store the different variables. E.g. Variables v1, v2,…Vn could be a new collection in Class1 with objects from “ClassV”.
Also, you are looping from i=2 to i=50000. Before the Next i, you can set set Class1 = Nothing to free memory.
Related
Let me explain.
I have a state similarity implementation in excel. One module, called a state, contains many public dictionaries at the top level.
I fill each dictionary with a huge number of object classes - mostly just data from sheets. Simple practice. The problem starts after the macro has worked normally, it leaves all these dictionaries in memory, in the task manager the Excel occupies from 2GB - this is also normal.
State Module - Standalone module
public Dict1 as Dictionary
public Dict2 as Dictionary
'Persists sheets data
public Dict3 as Dictionary
public Dict4 as Dictionary
'For persists renaming some objs
public Dict5 as Dictionary
public Dict6 as Dictionary
public Dict7 as Dictionary
Class Module - Data Interface Example - clsData
Public Name as string
Public Prop1 as string
Public Prop2 as Integer
Public Prop3 as Date
Public Prop4 as string
Public Value as double
The code below is just an example for stackoverflow. In my modules I am grabbing data from a sheet with the Range.CurrentRegion and iterate lbound to ubound.
Another data grabber
Function DataGrabberFromSheet(ByRef CurrentDict as Dict) as String
Dim i as long
Dim data as variant
Dim DataObj as clsData
set CurrentDict = New Dictionary <--- That's recreate dict obj and start clear old data for some how, but i do not need that anymore.
data = Sheet1.Range("A1:Q5000").Values
for i = 1 to 5000
set DataObj = new clsData
DataObj.Name = data(i, 1)
DataObj.Prop1 = data(i,2)
...
call CurrentDict.add(DataObj.Name, DataObj)
next
'For logging, it just an example:
If Success then
DataGrabberFromSheet = "Success"
else
DataGrabberFromSheet = "Bad"
endif
end Function
And so I decide in the debbuger to forcibly stop the program by pressing the stop button. At this point, Excel freezes for a long time, because I already have 50 or more of these dictionaries in the RAM, some of them have 200k elements each. Sometimes it takes about 300 seconds, and sometimes it instantly clears it somehow.
Old data erase by item, I think, but I do not need that data anymore. Can excel just skip that part of memory and just rewrite a new data.
How can I instantly redefine these dictionaries when the macro is rerun and not have to wait for that long cleanup? data is no longer needed at this point
Classic internet methods optimisations not solved that problem:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
...
I think this is a known issue with VBA - clearing a large number of objects takes a long time: regardless of whether they're stored in a dictionary, collection, or an array.
For example:
Dim arr() As clsData
Sub Tester()
Const NUM As Long = 120000
Dim i As Long, obj As clsData, t
t = Timer
Debug.Print "---------"
ReDim arr(1 To NUM)
Debug.Print "Reset", Timer - t
t = Timer
For i = 1 To NUM
Set obj = New clsData
obj.Prop1 = "Item" & i
obj.Prop2 = "Item" & i
obj.Prop3 = "Item" & i
obj.Prop4 = "Item" & i
Set arr(i) = obj
Next i
Debug.Print "Fill", Timer - t
End Sub
Where clsData is just:
Public Prop1
Public Prop2
Public Prop3
Public Prop4
Output from first run (after clicking "Stop" in VBE):
Reset 0
Fill 0.34375
Second run:
Reset 8.601563 <<<<<
Fill 0.3554688
I've created some simple classes in excel and I'm trying to create new objects from these classes. It works fine and let's me create them and I can also access the variables given to the object. I can't see the object in the local window though and I don't really understand why. Is it not created correctly because you are supposed to see your objects there I understand?
Here is the code for the class
Option Explicit
'Teams
Public Name As String
Public Group As String
Public GF As Integer
Public GA As Integer
Public Points As Integer
'Public Players(25) As String
Private Sub class_initialize()
Points = 5
End Sub
and here is the code where I try to create an object
Sub TestTeams()
Dim Madagaskar As Object
Set Madagaskar = New ETeam
MsgBox (Madagaskar.Points)
End Sub
If you put Stop on the line after the MsgBox call and run TestTeams, you will see the object in the locals window.
It will only be there while Madagaskar is in scope and you're in break mode.
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 2 years ago.
Improve this question
my code is
Public Function notcpuid()
Dim m As String
Const test = "BFEBF55555555"
m = GetCPUID
If m <> test Then
notcpuid = True
Else
notcpuid = False
End If
End Function
Function GetCPUID() As String
Dim cimv2, PInfo, PItem ' no idea what to declare these as
Dim PubStrComputer As String
PubStrComputer = "."
Set cimv2 = GetObject("winmgmts:\\" & PubStrComputer & "\root\cimv2")
Set PInfo = cimv2.ExecQuery("Select * From Win32_Processor")
For Each PItem In PInfo
Next PItem
GetCPUID = PItem.ProcessorID
End Function
Private Sub Workbook_Open()
If notcpuid Then
ThisWorkbook.Close
End If
End Sub
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
i want excel file protection by vba cpuid.
Declare the items as Object.
You also have your For Each loop out of order.
Function GetCPUID() As String
Dim cimv2 As Object
Dim PInfo As Object
Dim PItem As Object
Dim PubStrComputer As String
PubStrComputer = "."
Set cimv2 = GetObject("winmgmts:\\" & PubStrComputer & "\root\cimv2")
Set PInfo = cimv2.ExecQuery("Select * From Win32_Processor")
For Each PItem In PInfo
GetCPUID = PItem.ProcessorID
Next PItem
End Function
BTW, you do know that identical CPUs will return the same ID? Not the same as a serial number. For example:
Item Value
------ -----
Processor Name Intel(R) Core(TM) i7-7700 CPU # 3.60GHz
Code Name Kaby Lake
Info Intel64 Family 6 Model 158 Stepping 9
Maker GenuineIntel
ID BFEBFBFF000906E9
Max CPU Speed 3.6 GHz
Physical CPUs 1
Physical Cores 4
Logical Cores 8
Address Width 64
HyperThreading Enabled
VM Firmware Disabled
Socket U3E1
Update: Using Powershell I looked at the properties for the CPU_Object. It includes a Serial number but when checked on my PC I got this:
PS> $CPU_Object.serialnumber
To Be Filled By O.E.M.
HTH
I am coding a Manager in Excel-VBA with several buttons.
One of them is to generate a tab using another Excel file (let me call it T) as input.
Some properties of T:
~90MB size
~350K lines
Contains sales data of the last 14 months (unordered).
Relevant columns:
year/month
total-money
seller-name
family-product
client-name
There is not id columns (like: cod-client, cod-vendor, etc.)
Main relation:
Sellers sells many Products to many Clients
I am generating a new Excel tab with data from T of the last year/month grouped by Seller.
Important notes:
T is the only available input/source.
If two or more Sellers sells the same Product to the same Client, the total-money should be counted to all of those Sellers.
This is enough, now you know what I have already coded.
My code works, but, it takes about 4 minutes of runtime.
I have already coded some other buttons using smaller sources (not greater than 2MB) which runs in 5 seconds.
Considering T size, 4 minutes runtime could be acceptable.
But I'm not proud of it, at least not yet.
My code is mainly based on Scripting.Dictionary to map data from T, and then I use for each key in obj ... next key to set the grouped data to the new created tab.
I'm not sure, but here are my thoughts:
If N is the total keys in a Scripting.Dictionary, and I need to check for obj.Exists(str) before aggregating total-money. It will run N string compares to return false.
Similarly it will run maximun N string compares when I do Set seller = obj(seller_name).
I want to be wrong with my thoughts. But if I'm not wrong, my next step (and last hope) to reduce the runtime of this function is to code my own class object with Tries.
I will only start coding tomorrow, what I want is just some confirmation if I am in the right way, or some advices if I am in the wrong way of doing it.
Do you have any suggestions? Thanks in advance.
Memory Limit Exceeded
In short:
The main problem was because I used a dynamic programming approach of storing information (preprocessing) to make the execution time faster.
My code now runs in ~ 13 seconds.
There are things we learn the hard way. But I'm glad I found the answer.
Using the Task Manager I was able to see my code reaching 100% memory usage.
The DP approach I mentioned above using Scripting.Dictionary reached 100% really faster.
The DP approach I mentioned above using my own cls_trie implementation also reached 100%, but later than the first.
This explains the ~4-5 min compared to ~2-3 min total runtime of above attempts.
In the Task Manager I could also see that the CPU usage never hited 2%.
Solution was simple, I had to balance CPU and Memory usages.
I changed some DP approaches to simple for-loops with if-conditions.
The CPU usage now hits ~15%.
The Memory usage now hits ~65%.
I know this is relative to the CPU and Memory capacity of each machine. But in the client machine it is also running in no more than 15 seconds now.
I created one GitHub repository with my cls_trie implementation and added one excel file with an example usage.
I'm new to the excel-vba world (4 months working with it right now). There might probably have some ways to improve my cls_trie implementation, I'm openned to suggestions:
Option Explicit
Public Keys As Collection
Public Children As Variant
Public IsLeaf As Boolean
Public tObject As Variant
Public tValue As Variant
Public Sub Init()
Set Keys = New Collection
ReDim Children(0 To 255) As cls_trie
IsLeaf = False
Set tObject = Nothing
tValue = 0
End Sub
Public Function GetNodeAt(index As Integer) As cls_trie
Set GetNodeAt = Children(index)
End Function
Public Sub CreateNodeAt(index As Integer)
Set Children(index) = New cls_trie
Children(index).Init
End Sub
'''
'Following function will retrieve node for a given key,
'creating a entire new branch if necessary
'''
Public Function GetNode(ByRef key As Variant) As cls_trie
Dim node As cls_trie
Dim b() As Byte
Dim i As Integer
Dim pos As Integer
b = CStr(key)
Set node = Me
For i = 0 To UBound(b) Step 2
pos = b(i) Mod 256
If (node.GetNodeAt(pos) Is Nothing) Then
node.CreateNodeAt pos
End If
Set node = node.GetNodeAt(pos)
Next
If (node.IsLeaf) Then
'already existed
Else
node.IsLeaf = True
Keys.Add key
End If
Set GetNode = node
End Function
'''
'Following function will get the value for a given key
'Creating the key if necessary
'''
Public Function GetValue(ByRef key As Variant) As Variant
Dim node As cls_trie
Set node = GetNode(key)
GetValue = node.tValue
End Function
'''
'Following sub will set a value to a given key
'Creating the key if necessary
'''
Public Sub SetValue(ByRef key As Variant, value As Variant)
Dim node As cls_trie
Set node = GetNode(key)
node.tValue = value
End Sub
'''
'Following sub will sum up a value for a given key
'Creating the key if necessary
'''
Public Sub SumValue(ByRef key As Variant, value As Variant)
Dim node As cls_trie
Set node = GetNode(key)
node.tValue = node.tValue + value
End Sub
'''
'Following function will validate if given key exists
'''
Public Function Exists(ByRef key As Variant) As Boolean
Dim node As cls_trie
Dim b() As Byte
Dim i As Integer
b = CStr(key)
Set node = Me
For i = 0 To UBound(b) Step 2
Set node = node.GetNodeAt(b(i) Mod 256)
If (node Is Nothing) Then
Exists = False
Exit Function
End If
Next
Exists = node.IsLeaf
End Function
'''
'Following function will get another Trie from given key
'Creating both key and trie if necessary
'''
Public Function GetTrie(ByRef key As Variant) As cls_trie
Dim node As cls_trie
Set node = GetNode(key)
If (node.tObject Is Nothing) Then
Set node.tObject = New cls_trie
node.tObject.Init
End If
Set GetTrie = node.tObject
End Function
You can see in the above code:
I hadn't implemented any delete method because I didn't need it till now. But it would be easy to implement.
I limited myself to 256 children because in this project the text I'm working on is basically lowercase and uppercase [a-z] letters and numbers, and the probability that two text get mapped to the same branch node tends zero.
as a great coder said, everyone likes his own code even if other's code is too beautiful to be disliked [1]
My conclusion
I will probably never more use Scripting.Dictionary, even if it is proven that somehow it could be better than my cls_trie implementation.
Thank you all for the help.
I'm convinced that you've already found the right solution because there wasn't any update for last two years.
Anyhow, I want to mention (maybe it will help someone else) that your bottleneck isn't the Dictionary or Binary Tree. Even with millions of rows the processing in memory is blazingly fast if you have sufficient amount of RAM.
The botlleneck is usually the reading of data from worksheet and writing it back to the worksheet. Here the arrays come very userfull.
Just read the data from worksheet into the Variant Array.
You don't have to work with that array right away. If it is more comfortable for you to work with dictionary, just transfer all the data from array into dictionary and work with it. Since this process is entirely made in memory, don't worry about the performance penalisation.
When you are finished with data processing in dictionary, put all data from dictionary back to the array and write that array into a new worksheet at one shot.
Worksheets("New Sheet").Range("A1").Value = MyArray
I'm pretty sure it will take only few seconds
I would like to declare kind of global variables. What I want to do is initialize these variables, then use them in macros, and change their values in other macros.
I started to write it as public variables:
Option Explicit
'definition of global variables
Public r_start As Integer
Public r_end As Integer
Public c_little As Integer
Public c_big As Integer
Public c_sel_start As Integer
Public c_sel_end As Integer
Public c_data_start As Integer
Public c_data_end As Integer
Public Sub Init_Globals()
' Access global variable initialization
r_start = 20
r_end = 833
c_little = 6
c_big = 5
c_sel_start = 1
c_sel_end = 4
c_data_start = 11
c_data_end = 101
End Sub
The problem here is that I have to call Sub_Init_Globals() in each of my SubProcedure, and so if I want to change the initial values of my global variables inside other SubProcedures, those changes won't be made.
Do you know a way to create such variables ?
As far as I understood these are just starting values what leaves you with next options:
1.) You can declare these variables and assign values in Workbook_Open sub.
More here Is it possible to declare a public variable in vba and assign a default value?
2.) Create separate sheet, that will be hidden, with support table consisting of these values, in this case all changes to these values will be saved even after you close Workbook.
3.) Declare constants and assign it's value to a different variable inside Procedures.
Public Const YourVariableName as Integer = 1
(or any other type or value of course) at the top of any user module seems to do the trick.