VBA collection: list of keys

Question

After I add some values to the VBA collection, is there any way to retain the list of all keys?

For example

Dim coll as new  Collection
Dim str1, str2, str3
str1="first string"
str2="second string"
str3="third string"
coll.add str1, "first key"
coll.add str2, "second key"
coll.add str3, "third key"

I know how to retain the list of strings:

first string
second string
third string

Once again: is there any way to retain the keys?

first key
second key
third key

Note: I'm using VBA through AutoCAD 2007

score 53 · Answer 1 · answered Apr 18 '11 at 12:00

53

If you intend to use the default VB6 Collection, then the easiest you can do is:

col1.add array("first key", "first string"), "first key"
col1.add array("second key", "second string"), "second key"
col1.add array("third key", "third string"), "third key"

Then you can list all values:

Dim i As Variant

For Each i In col1
  Debug.Print i(1)
Next

Or all keys:

Dim i As Variant

For Each i In col1
  Debug.Print i(0)
Next

answered Apr 18 '11 at 12:00

GSerg

76,472
17
159
346

2

I was using this solution before. I was looking for something more _pretty_. But thank you, anyway :) – Artur Iwan Apr 18 '11 at 13:34
3

Nice solution, seems quite pretty to me, dictionaries may be more powerful but this works without external dependencies on Windows scripting, i.e. also on Mac OS, and does not require extra maintenance or other class – nkatsar Jun 18 '17 at 16:09
7

When using this you might prefer to use **VBA.Array**, i.e. `col1.add VBA.Array("first key", "first string"), "first key"` , to avoid different lower bounds caused by "Option Base 1". This way the lower bound of the resulting array will always be **0** – nkatsar Jun 18 '17 at 16:31

Alex K. · Accepted Answer · 2018-11-19T17:59:27.030

49

I don't thinks that possible with a vanilla collection without storing the key values in an independent array.

The easiest alternative to do this is to add a reference to the Microsoft Scripting Runtime & use a more capable Dictionary instead:

Dim dict As Dictionary
Set dict = New Dictionary

dict.Add "key1", "value1"
dict.Add "key2", "value2"

Dim key As Variant
For Each key In dict.Keys
    Debug.Print "Key: " & key, "Value: " & dict.Item(key)
Next

edited Nov 19 '18 at 17:59

answered Apr 18 '11 at 12:00

Alex K.

171,639
30
264
288

1

I would like to say yes for all recent versions of windows as its part of windows scripting, but I can't see a definitive answer. – Alex K. Apr 18 '11 at 13:43
9

Just to clarify, this approach should work on all Windows OS but it will not work on Mac OS. – David Zemens Apr 22 '15 at 15:56
1

You can also use late binding to avoid having to add the reference on different computers. – bmende Oct 14 '15 at 16:00
3

For cross platform compatibility you can use a class module. See: https://stackoverflow.com/questions/19869266/vba-excel-dictionary-on-mac Source code available on GitHub: https://github.com/VBA-tools/VBA-Dictionary – robartsd Mar 30 '18 at 16:35

score 16 · Answer 3 · answered Mar 29 '12 at 23:33

You can create a small class to hold the key and value, and then store objects of that class in the collection.

Class KeyValue:

Public key As String
Public value As String
Public Sub Init(k As String, v As String)
    key = k
    value = v
End Sub

Then to use it:

Public Sub Test()
    Dim col As Collection, kv As KeyValue
    Set col = New Collection
    Store col, "first key", "first string"
    Store col, "second key", "second string"
    Store col, "third key", "third string"
    For Each kv In col
        Debug.Print kv.key, kv.value
    Next kv
End Sub

Private Sub Store(col As Collection, k As String, v As String)
    If (Contains(col, k)) Then
        Set kv = col(k)
        kv.value = v
    Else
        Set kv = New KeyValue
        kv.Init k, v
        col.Add kv, k
    End If
End Sub

Private Function Contains(col As Collection, key As String) As Boolean
    On Error GoTo NotFound
    Dim itm As Object
    Set itm = col(key)
    Contains = True
MyExit:
    Exit Function
NotFound:
    Contains = False
    Resume MyExit
End Function

This is of course similar to the Dictionary suggestion, except without any external dependencies. The class can be made more complex as needed if you want to store more information.

Is there any advantage to using this method over the dictionary suggestion? Can you explain the disadvantage of an external dependency in this case? — Scott Conover, Aug 08 '12 at 17:42
The main the disadvantage of an external dependency is... to be an external dependency. Maybe an old Windows or a MAcOs, go figure... — Marcelo Scofano Diniz, Oct 13 '19 at 17:28
At first I thought this was basically the same as using the array pair method shown above. However, this seems to have two benefits: 1.) the key and value are identified as such, so for example you can obtain the key with "col(1).key". 2.) you show here that by using the class, the values of members of the collection can be directly updated. Arrays don't seem to allow the same. Neat! — Mark E., Mar 29 '21 at 03:37

ChrisMercator · Answer 4 · 2018-04-30T05:48:11.177

You can snoop around in your memory using RTLMoveMemory and retrieve the desired information directly from there:

32-Bit:

Option Explicit

'Provide direct memory access:
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, _
    ByVal Source As Long, _
    ByVal Length As Long)


Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As Long
    Dim KeyPtr As Long
    Dim ItemPtr As Long

    'Get MemoryAddress of Collection Object
    CollPtr = VBA.ObjPtr(oColl)

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 16)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLong(CollPtr + 24)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLong(ItemPtr + 16)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLong(ItemPtr + 24)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function


'Peek Long from given MemoryAddress
Public Function PeekLong(Address As Long) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4&)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As Long) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, Length)

End Function

64-Bit:

Option Explicit

'Provide direct memory access:
Public Declare PtrSafe Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
     ByVal Destination As LongPtr, _
     ByVal Source As LongPtr, _
     ByVal Length As LongPtr)



Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As LongPtr
    Dim KeyPtr As LongPtr
    Dim ItemPtr As LongPtr

    'Get MemoryAddress of Collection Object
    CollPtr = VBA.ObjPtr(oColl)

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 28)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLongLong(CollPtr + 40)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLongLong(ItemPtr + 24)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLongLong(ItemPtr + 40)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function


'Peek Long from given Memory-Address
Public Function PeekLong(Address As LongPtr) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4^)

End Function

'Peek LongLong from given Memory Address
Public Function PeekLongLong(Address As LongPtr) As LongLong

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLongLong), Address, 8^)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As LongPtr) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, CLngLng(Length))

End Function

Redim Temp(1 to ElementCount) eliminates the empty array element at index 0. Brilliant code by the way. Much appreciated. — freeflow, Feb 27 '23 at 13:08

score 9 · Answer 5 · answered Sep 23 '11 at 07:56

9

An alternative solution is to store the keys in a separate Collection:

'Initialise these somewhere.
Dim Keys As Collection, Values As Collection

'Add types for K and V as necessary.
Sub Add(K, V) 
Keys.Add K
Values.Add V, K
End Sub

You can maintain a separate sort order for the keys and the values, which can be useful sometimes.

answered Sep 23 '11 at 07:56

Anonymous Coward

91
1
1

I used similiar algorithm sometimes, before Alex K. told me about the Dictionary. Now I use Dictionary and it's much better :) but thank you anyway. – Artur Iwan Apr 25 '12 at 07:59

score -1 · Answer 6 · answered Sep 02 '19 at 09:25

-1

You can easily iterate you collection. The example below is for the special Access TempVars collection, but works with any regular collection.

Dim tv As Long
For tv = 0 To TempVars.Count - 1
    Debug.Print TempVars(tv).Name, TempVars(tv).Value
Next tv

answered Sep 02 '19 at 09:25

iDevlop

24,841
11
90
149

VBA collection: list of keys

6 Answers6

Linked

Related