How to access object in collection more quickly

[OldClock]

How you access an object in a collection makes up to a magnitude of difference:

Dim c As Collection
Dim o As New SomeObject
Dim ll As Long
Dim idx As Long
 
Debug.Print Now
 
Debug.Print "Populate collection"
Call measureTimeStart
Set c = New Collection
For ll = 1 To 1000
    Set o = New SomeObject
    c.Add o
Next
Call measureTimeStop
 
Debug.Print "For Each"
Call measureTimeStart
For ll = 1 To 1000
    For Each o In c
        If o.id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop
 
Debug.Print "By index"
Call measureTimeStart
For ll = 1 To 1000
    For idx = 1 To c.Count
        Set o = c(idx)
        If o.id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop
 
Debug.Print "CallByName"
Call measureTimeStart
For ll = 1 To 1000
    For idx = 1 To c.Count
        If CallByName(c.Item(idx), "id", VbGet) = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop
 
Debug.Print vbNewLine

The results:

2019-03-18 7:28:00 PM 
Populate collection
5.797ms
For Each
500.9564ms
By index
5587.8786ms
CallByName
8702.121ms

Clarification:
MeasureTime* are my accurate time-measurement functions which use QueryPerformance* in kernel32.
SomeObject is a simple class module with an "id" property of the Currency type.

500ms is still a long time for just 1 000 000 objects.

Do you know of any faster methods?

[Zvoni]

If you don't need the "special" methods of a collection (For Each, Insert/Remove at Positon, Unique Key etc.) use an array and be done with it

[OldClock]

That is completely off-topic.

[OldClock]

Using Olaf Schmidt's RichClient5:

2019-03-18 8:12:54 PM 
Populate collection
126.9146ms
For Each
578.7012ms
By index
494.5912ms
CallByName
2761.0677ms

[Shaggy Hiker]

If there's anything like a Dictionary in VB6, they tend to be FAR faster, as long as you can be looking things up by a specific key all the time. If you are looking things up by random fields, it gets more interesting.

[wqweto]

Do you know of any faster methods?

You can try accessing collection items *by key* -- which is he fastest way but this means you'll have to change the way you populate your collection.

Currently you just pile the items w/ c.Add o like in an array/list but you'll have to come up with *unique* keys like in a dictionary e.g. try c.Add o, "#" & o.id

cheers,
</wqw>

[jpbro]

Looks like you are running each loop 1000 times over 1000 item collections, so it's actually 500ms for 1,000,000 tests.

In my tests of the VB6 Collection vs. the RC5 Collection, they are both about the same with For Each, but RC5 outperforms the VB6 Collection by Index dramatically (and is also about 2x as fast as For...Each).


My RC5 Code below. NOTE I skipped the object property access since that is unrelated to testing the performance of the collection object.

Sub Test()
    Dim c As cCollection
    Dim o As New SomeObject
    Dim ll As Long
    Dim idx As Long
     
    Debug.Print Now
     
    Set c = New cCollection
    
    Debug.Print "Populate collection"
    New_c.Timing True
    For ll = 1 To 1000
        Set o = New SomeObject
        c.Add o
    Next
    Debug.Print New_c.Timing
    
    Debug.Print "For Each"
    New_c.Timing True
    For ll = 1 To 1000
        For Each o In c
        Next
    Next
    Debug.Print New_c.Timing
    
    Debug.Print "By index"
    New_c.Timing True
    For ll = 1 To 1000
        For idx = 0 To c.Count - 1
            Set o = c.ItemByIndex(idx)
        Next
    Next
    Debug.Print New_c.Timing
     
    Debug.Print vbNewLine
End Sub

Timing for 1,000,000 accesses:

For Each
 368.55msec

By index
 244.33msec

[jpbro]

BTW I just tried an object array (e.g. Dim X(1 to 1000) As Object), and it performed the best, but not by too much. Around 180ms vs. 244ms for the RC5 cCollection access by Index. So if you need the extra features of the cCollection object, you won't be sacrificing much speed. If you are using those features, then you might as well just use an object array.

[OldClock]

Here is a comparison using the "Dictionary" class.
Note: I haven't used Dictionaries before, so there might be a better way of accessing the data than the way I used below. This is the best I could figure out with no documentation available.

Dim d As Dictionary
Dim k As Variant
Dim o As New SomeObject
Dim ll As Long
Dim idx As Long
 
Debug.Print "Populate dictionary"
Call measureTimeStart
Set d = New Dictionary
For ll = 1 To 1000
    Set o = New SomeObject
    d.Add ll, o
Next
Call measureTimeStop
 
Debug.Print "By key, directly"
Call measureTimeStart
For ll = 1 To 1000
    For Each k In d.Keys
        If d(k).id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop
 
Debug.Print "By key, set"
Call measureTimeStart
For ll = 1 To 1000
    For Each k In d.Keys
        Set o = d(k)
        If o.id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop
 
Debug.Print "By key, index"
Call measureTimeStart
For ll = 1 To 1000
    For idx = 0 To d.Count - 1
        Set o = d.Items(idx)
        If o.id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop

Interestingly enough, there was a significant difference when I set the key to a long vs a string.

Timing results using string as key

d.Add "key" & ll, o

Populate dictionary
7.7568ms
By key, directly
3469.8339ms
By key, set
1175.8321ms
By key, index
67188.6856ms

Timing results using long as key

d.Add ll, o

Populate dictionary
6.1332ms
By key, directly
2807.276ms
By key, set
696.7535ms
By key, index
60142.6665ms

[OldClock]

Same test as in first post but this time using a string key, and instead of "CallByName" I tested accessing by key as suggested by wqweto.

Dim c As Collection
Dim o As New SomeObject
Dim ll As Long
Dim idx As Long
 
Debug.Print Now
Debug.Print "ll"
 
Debug.Print "Populate collection"
Call measureTimeStart
Set c = New Collection
For ll = 1 To 1000
    Set o = New SomeObject
    c.Add o, "key" & ll
Next
Call measureTimeStop
 
Debug.Print "For Each"
Call measureTimeStart
For ll = 1 To 1000
    For Each o In c
        If o.id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop
 
Debug.Print "By index"
Call measureTimeStart
For ll = 1 To 1000
    For idx = 1 To c.Count
        Set o = c(idx)
        If o.id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop
 
Debug.Print "By key"
Call measureTimeStart
For ll = 1 To 1000
    For idx = 1 To c.Count
        Set o = c("key" & idx)
        If o.id = 1234567890123# Then
        End If
    Next
Next
Call measureTimeStop

Timing results using string as key

c.Add o, "key" & ll

Populate collection
9.8956ms
For Each
412.3755ms
By index
5158.9206ms
By key
1666.4321ms

Timing results using long as key

c.Add o, ll

Populate collection
7.33ms
For Each
417.5861ms
By index
5180.8298ms
By key
1672.3316ms

[OldClock]

> Looks like you are running each loop 1000 times over 1000 item collections, so it's actually 500ms for 1,000,000 tests.

Thank you for spotting that typo, corrected.

[Elroy]

OldClock,

I read your OP and also took a good look at your code. I also scanned all the subsequent posts, but I'd just like to address your OP.

The very first thing I noticed was that you're not using the String key of the collection. The power of collections comes with the use of this String key. They are organized into a Binary-Tree for quick search and access of the Variant data (in your case, the object) of the collection.

I studied your example code, and couldn't make heads-or-tails of what you're actually trying to do. Maybe it was just some test code for speed testing. If you would really like to use a collection with lots of items and you want to subsequently find them quickly, you really should find a way to use the String key.

Just trying to figure out your code, you might use your ID as the String key. Or, in other circumstances, I've used CStr(ObjPtr(SomeObject)) as the String key. It just depends on what you're trying to do.

Without a key (String), collections are no better (and possibly worse) than an array. In that case, the only advantage you'd have is that you could use the .Add method rather than having to mess with ReDim. If you ReDim one-item-at-a-time, a collection's .Add method will be much faster. But if you "step" your array, and maybe add 1000 items at a time (and then ReDim to correct size at the end), an array will be faster.

And, as stated above, if you don't mind an additional project reference, the dictionary is even faster than the collection. However, again, it will depend on you having some defined key. It's these keys that give all of these things their power.

I'll admit that I do occasionally use collections without keys, but only for a quick gathering of a few items. For instance, if I don't want to keep a Dir$ active, and I want to quickly gather the files in a folder, I might use a collection to store these file names. There are other circumstances as well. But, in these cases, because there are so few items, I've got no concern over speed.

Good Luck,
Elroy

EDIT1: I just noticed that Wqweto gave you essentially the same advice I'm giving you. The key is the key.

[dilettante]

Scripting.Dictionary has issues of its own. For example iteration must be done by extracting every item (or key) into an array and then iterating that. It has no COM enumerator. This can eat performance alive if your Dictionary is large and you aren't paying attention.

[The trick]

Scripting.Dictionary has issues of its own. For example iteration must be done by extracting every item (or key) into an array and then iterating that. It has no COM enumerator. This can eat performance alive if your Dictionary is large and you aren't paying attention.

No, it supports enumeration.

[wqweto]

Dictionary's IEnumVARIANT support came up 5+ years ago when I had to cobble up this sample gist, trying to prove or reject its support for For Each through DISPID_NEWENUM (-4).

cheers,
</wqw>

[The trick]

wqweto, just checking it supports as least from XP.

11352	1:02:33.591 PM	1	ole32.dll	IDictionary::Invoke ( DISPID_NEWENUM, IID_NULL, 1033, DISPATCH_METHOD | DISPATCH_PROPERTYGET, 0x0018f9fc, 0x0018fa0c, 0x0018f9dc, 0x0018fa28 )	S_OK		0.0011768
...
11625	1:02:33.623 PM	1	scrrun.dll	ITypeInfo::Invoke ( 0x002a1948, DISPID_NEWENUM, DISPATCH_METHOD | DISPATCH_PROPERTYGET, 0x0018f9fc, 0x0018fa0c, 0x0018f9dc, 0x0018fa28 )	S_OK		0.0000435
...
11631	1:02:33.623 PM	1	ole32.dll	IDictionary::_NewEnum ( 0x0018f6d4 )	S_OK		0.0000147
...
11640	1:02:33.623 PM	1	ole32.dll	IUnknown::QueryInterface ( IEnumVARIANT, 0x0018fa68 )	S_OK		0.0000015
11641	1:02:33.623 PM	1	ole32.dll	IUnknown::Release (  )	1		0.0000015
11642	1:02:33.623 PM	1	ole32.dll	IEnumVARIANT::Next ( 1, 0x0018fabc, NULL )	S_OK		0.0000103
...
11643	1:02:33.623 PM	1	scrrun.dll	VariantCopy ( 0x0018fabc, 0x002a1998 )	S_OK		0.0000073

[dilettante]

That's good news. Then most of the examples of iteration Microsoft shows for Dictionary are just sloppy?

Most of them look like:

Dim a, d, i             'Create some variables
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"     'Add some keys and items
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
a = d.Items             'Get the items
For i = 0 To d.Count -1 'Iterate the array
    Print a(i)          'Print item
Next

Or else they do a For Each on the .Items method itself.


I tried this and got the keys:

Dim d, e    
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
For Each e In d
    Debug.Print e
Next

a
b
c

[Thierry69]

Here is the result on my computer.
I also added the test on my own class_Collection (heavilly used) wich implements more things (like dictionnary), and seems slower when retrieving by a key.
I will check if I can optimize search by key
NB : Enum is not implemented

19/03/2019 11:03:21

Populate collection
1,7764
Collection-For Each
81,7892
Collection-By index
665,1863
Collection-By index with item
687,2527
Collection-By key
680,7462
Collection-By key item
648,9414


Populate class_Collection
4,2593
class_Collection-By index
490,5783
class_Collection-By key
1311,0298

[Zvoni]

That is completely off-topic.

How is my answer offtopic when 2 people referenced the same i did in my answer!

[Thierry69]

NB Bis, here is the test code :

Option Explicit

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

Dim cTimer              As Currency

Private Sub measureTimeStart()
   QueryPerformanceCounter cTimer
End Sub

Private Sub measureTimeStop()
   Dim cTimerBis        As Currency

   QueryPerformanceCounter cTimerBis

   Debug.Print cTimerBis - cTimer

End Sub

Private Sub Form_Load()
   Dim c                As Collection
   Dim o                As New Class1
   Dim ll               As Long
   Dim idx              As Long

   Debug.Print Now

   Debug.Print "Populate collection"
   Call measureTimeStart
   Set c = New Collection
   For ll = 1 To 1000
      Set o = New Class1
      c.Add o, "key" & ll
   Next
   Call measureTimeStop

   Debug.Print "Collection-For Each"
   Call measureTimeStart
   For ll = 1 To 1000
      For Each o In c
         If o.id = 1234567890123# Then
         End If
      Next
   Next
   Call measureTimeStop

   Debug.Print "Collection-By index"
   Call measureTimeStart
   For ll = 1 To 1000
      For idx = 1 To c.Count
         Set o = c(idx)
         If o.id = 1234567890123# Then
         End If
      Next
   Next
   Call measureTimeStop

   Debug.Print "Collection-By index with item"
   Call measureTimeStart
   For ll = 1 To 1000
      For idx = 1 To c.Count
         Set o = c.Item(idx)
         If o.id = 1234567890123# Then
         End If
      Next
   Next
   Call measureTimeStop

   Debug.Print "Collection-By key"
   Call measureTimeStart
   For ll = 1 To 1000
      For idx = 1 To c.Count
         Set o = c("key" & idx)
         If o.id = 1234567890123# Then
         End If
      Next
   Next
   Call measureTimeStop

   Debug.Print "Collection-By key item"
   Call measureTimeStart
   For ll = 1 To 1000
      For idx = 1 To c.Count
         Set o = c.Item("key" & idx)
         If o.id = 1234567890123# Then
         End If
      Next
   Next
   Call measureTimeStop

   Debug.Print
   Debug.Print

   ' *** Class_Collection
   Dim c2               As class_Collection
   Debug.Print "Populate class_Collection"
   Call measureTimeStart
   Set c2 = New class_Collection
   For ll = 1 To 1000
      Set o = New Class1
      c2.AddItem o, "key" & ll
   Next
   Call measureTimeStop

   '   Debug.Print "For Each"
   '   Call measureTimeStart
   '   For ll = 1 To 1000
   '      For Each o In c2
   '         If o.id = 1234567890123# Then
   '         End If
   '      Next
   '   Next
   '   Call measureTimeStop

   Debug.Print "class_Collection-By index"
   Call measureTimeStart
   For ll = 1 To 1000
      For idx = 1 To c2.ItemCount
         Set o = c2.Item(idx)
         If o.id = 1234567890123# Then
         End If
      Next
   Next
   Call measureTimeStop

   Debug.Print "class_Collection-By key"
   Call measureTimeStart
   For ll = 1 To 1000
      For idx = 1 To c2.ItemCount
         Set o = c2.Item("key" & idx)
         If o.id = 1234567890123# Then
         End If
      Next
   Next
   Call measureTimeStop

End Sub

[The trick]

I tried this and got the keys:

Yes, it iterates through the keys, you can use the key to access the item. It's the quite cheap operation because the dictionary is a hash table.
Alternatively you can access the keys using the internal structure of the hash table:

' ObjPtr+&H18 (Dic.Count)
' Get the items
Private Function Items(Dic As Dictionary) As Variant
    Dim pItm As Long, loc() As Variant, i As Long
    
    ReDim loc(Dic.Count - 1)

    GetMem4 ByVal ObjPtr(Dic) + &H1C, pItm

    Do
        VariantCopy loc(i), ByVal pItm + &H18

        GetMem4 ByVal pItm + 4, pItm
        i = i + 1
    Loop While pItm
    
    Items = loc
End Function

You can read the description of the dictionary object, it also contains the other codes to work with the dictionary.

[Arnoutdv]

As long as the Key is not used to retrieve data, but instead some property of the objects in the collection needs to be matched, then you will always end up iterating through all items.

In that case you can better an in-memory DB or a ADO recordset.

[Schmidt]

Here is a comparison using the "Dictionary" class.
Note: I haven't used Dictionaries before, so there might be a better way of accessing the data than the way I used below. This is the best I could figure out with no documentation available.

No matter, if you're using a Dictionary or a Collection for that -
looking at your code (and how you compare against the stored Objects-ID) -
I guess you only want to find a "stored Object" fast (using its "somewhat longer than a Long" ID).

So, why not add the Object in question using its ID as the Key?
(and yes - that Key may be of a different type than a VBString - as e.g. a Currency when you need some longer "Int-Value").

Here's your performance-test-loop, reduced to what's only needed, in case you only want a "fast way to find your o.ID"...
(using an RC5.cSortedDictionary):

Private Sub Form_Click()
   Dim d As cSortedDictionary, o As SomeObject
   Dim k As Currency, ll As Long

   New_c.Timing True
     Set d = New_c.SortedDictionary
     For ll = 1 To 1000
         k = 123456789000000@ + ll 'just an example for a longer currency-typed Key
         Set o = New SomeObject
             o.ID = k 'store the current Test-Key in the Object (this could be an internal ID of the Obj itself of course)
         d.Add o.ID, o '<- use the current (Currency-typed) o.ID-Key to store it in the dict
     Next
   Debug.Print "Populate dictionary: "; New_c.Timing
    
    
   New_c.Timing True
     For ll = 1 To 1000
         k = 123456789000000@ + ll
         Set o = d(k) 'there's no need to iterate through the collection, to find the o.ID - since it was used as the Dict-Key
         If o.ID <> k Then MsgBox "this shouldn't happen" 'a little test, just to show that the proper Object was indeed found
     Next
   Debug.Print "Obj-By-Key, directly: "; New_c.Timing
End Sub

The above comes out like that - performance-wise:

Populate dictionary:  2.41msec
Obj-By-Key, directly:  0.41msec

Olaf

[jpbro]

Here's your performance-test-loop, reduced to what's only needed, in case you only want a "fast way to find your o.ID"...
(using an RC5.cSortedDictionary):

I think you hit the nail on the head there. I took the original question at face value and stripped the "irrelevant" object property access since I didn't think those lines had anything to do with accessing collections more quickly, but I think you're right that the goal was to find a particular object.ID within a collection. If that's the case, then clearly the key should be the object.ID *unless* the Collection Key is also being used for other purposes, in which case multiple keys are needed and @Arnoutdv's database recommendation makes sense.

@OldClock - perhaps you could elaborate on what you are hoping/trying to accomplish?

[OldClock]

> So, why not add the Object in question using its ID as the Key?

In real life, that's what I do, and retrieve them from a collection by key. But there are cases when you need to iterate through all the objects of a collection, and that's where this test yields interesting results.

Note that in my test code I wrote "If o.id = 1234567890123# Then End If" and the intention behind it is causing confusion. I added that filler code as I was worried that a loop which does nothing would be optimized-away by the compiler. It wasn't the best choice of filler code. The purpose of the loop is not to find some specific object by ID, but to do something to all objects which are stored in that collection.

In most of my real-life use cases, the keys are formed using '"key" & obj.id' where the ID is of the currency data type, and the IDs are neither in order nor of a complete series.

[wqweto]

The purpose of the loop is not to find some specific object by ID, but to do something to all objects which are stored in that collection.

This reduces the question to a non-issue as For Each looping (using objects' custom IEnumVARIANT impl behind the scenes) is the fastest way intended by the container's creators . . . and this almost equalizes all of them on performance, bringing speed very close to plain array looping (which is theoretically fastest).

cheers,
</wqw>

[Arnoutdv]

I would create specific Indices / Lookup tables for these kind of requirements.
For each needed property create an additional lookup array or collection for quick access.
But beware, before you know it you have recreated the functionality of a disconnected ADO recordset.

[wqweto]

I'm heavily using VBA.Collections as (composite) key lookup indexes w/ disconnected ADO.Recordsets because Find method/Filter property have abysmal performance even with !MyField.Properties("Optimize").Value = True in-memory indexing.

cheers,
</wqw>

[OldClock]

Schmidt what is the difference between "Set d = New_c.SortedDictionary" and "Set d = New cSortedDictionary"?

I noticed that "Set ds = New_c.SortedDictionary" takes ~130ms the first time it's called, and 0.1ms subsequent times, so in the test code below I moved that outside the timers.

Test using Schmidt's cSortedDictionary:

Dim dc As cSortedDictionary
Dim ds As cSortedDictionary
Dim o As New SomeObject
Dim ll As Long
Dim idx As Long
 
Set dc = New_c.SortedDictionary
Set ds = New_c.SortedDictionary
 
Debug.Print vbNewLine & Now
 
Debug.Print "Populate dictionary, string as key"
Call measureTimeStart
For ll = 1 To 1000
    Set o = New SomeObject
    o.id = CCur(ll)
    ds.Add CStr(o.id), o
Next
Call measureTimeStop
 
Debug.Print "By key, string"
Call measureTimeStart
For ll = 1 To 1000
    For idx = 0 To ds.Count - 1
        Set o = ds(CStr(ll))
    Next
Next
Call measureTimeStop
 
Debug.Print "Populate dictionary, currency as key"
Call measureTimeStart
For ll = 1 To 1000
    Set o = New SomeObject
    o.id = CCur(ll)
    dc.Add o.id, o
Next
Call measureTimeStop
 
Debug.Print "By key, currency"
Call measureTimeStart
For ll = 1 To 1000
    For idx = 0 To dc.Count - 1
        Set o = dc(CCur(ll))
    Next
Next
Call measureTimeStop

Timing results:

2019-03-20 2:08:32 PM
Populate dictionary, string as key
5.7931ms
By key, string
762.6873ms
Populate dictionary, currency as key
6.1477ms
By key, currency
480.3076ms