CODEWITHSUNDEEP
arraysexceldictionaryvba
newdimension
newdimension

Reputation: 337

Two dimensional array as item of dictionary

I would like to populate a dictionary with several properties of an item. Example:

Sample data

I was thinking of having Item 1 and Item 2 as Dictionary keys with an array that would hold its properties. I would need to be able to separately access each property of an item so concatenating them as one string is not an option.

I'm thinking about something like the below pseudo-code:

    With Workbooks("testing macro").Sheets(test).Range("D7:G8")

     For i = 1 To .Rows.count

        items_dict.Add Key:=.Cells(i, 1).Value, _
 Item:= array(i,1)= .cells(i,2).value array(i,2)=.cells(i,3).value array(i,3).cells(i,4)

Upvotes: 5

Views: 12015

Answers (3)

paul bica
paul bica

Reputation: 10715

Another approach - dictionary of dictionaries:

Option Explicit

Public Sub nestedList()
    Dim ws As Worksheet, i As Long, j As Long, x As Variant, y As Variant, z As Variant
    Dim itms As Dictionary, subItms As Dictionary   'ref to "Microsoft Scripting Runtime"

    Set ws = Worksheets("Sheet1")
    Set itms = New Dictionary

    For i = 2 To ws.UsedRange.Rows.Count

        Set subItms = New Dictionary         '<-- this should pick up a new dictionary

        For j = 2 To ws.UsedRange.Columns.Count

            '           Key: "Property 1",          Item: "A"
            subItms.Add Key:=ws.Cells(1, j).Value2, Item:=ws.Cells(i, j).Value2

        Next

        '        Key: "Item 1",              Item: subItms
        itms.Add Key:=ws.Cells(i, 1).Value2, Item:=subItms

        Set subItms = Nothing                '<-- releasing previous object

    Next
    MsgBox itms("Item 3")("Property 3")      'itms(ws.Cells(3, 1))(ws.Cells(1, 3)) = "I"
End Sub

.

It adjusts dynamically to total number of rows and columns, so there is no maintenance needed

The benefit over collections is that you can check if keys exist or not

The slowest part is adding all items to dictionaries, but when done accessing the items is very fast

Note: Dictionaries cannot have duplicate Keys

.

Edit:

If you step through the code you'll be able to see the following objects:

DictionaryOfDictionaries

.

If you replace the MsgBox line with the following:

For Each x In itms.Keys
    For Each y In itms(x)
        If InStr(y, 1) > 0 Then
            Debug.Print vbNullString
            Debug.Print x & " ---> Key: '" & y & "' -> Item: '" & itms(x)(y) & "'"
        Else
            Debug.Print vbTab & vbTab & " -> Key: '" & y & "' -> Item: '" & itms(x)(y) & "'"
        End If
    Next
Next

You will get:

Item 1 ---> Key: 'Property 1' -> Item: 'A'
         -> Key: 'Property 2' -> Item: 'B'
         -> Key: 'Property 3' -> Item: 'C'

Item 2 ---> Key: 'Property 1' -> Item: 'D'
         -> Key: 'Property 2' -> Item: 'E'
         -> Key: 'Property 3' -> Item: 'F'

Item 3 ---> Key: 'Property 1' -> Item: 'G'
         -> Key: 'Property 2' -> Item: 'H'
         -> Key: 'Property 3' -> Item: 'I'

or type

For Each x In itms.Keys: For Each y in itms(x): Debug.Print x & " -> " & y & " -> " & itms(x)(y): Next: Next

in the Debug window

Upvotes: 2

Tmdean
Tmdean

Reputation: 9299

You can also do what you originally proposed by using the Array function to create a Variant array. If your data structure is getting this elaborate, it's usually better to have a data model class as in @sous2817's answer. But this technique is useful for adhoc, throwaway code.

Dim r As Range

For Each r In ['[testing macro.xlsx]test'!D7:G8].Rows
    ItemsDict.Add r.Cells(1).Value, Array( _
        r.Cells(2).Value, _
        r.Cells(3).Value, _
        r.Cells(4).Value)
Next

Upvotes: 2

sous2817
sous2817

Reputation: 3960

Here is a simple example using a class and a collection (basically modified from the examples here:

Class is pretty simple (class name is Employee):

Option Explicit

Private pName As String
Private pAddress As String
Private pSalary As Double

Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property
Public Property Get Address() As String
    Address = pAddress
End Property
Public Property Let Address(Value As String)
    pAddress = Value
End Property
Public Property Get Salary() As Double
    Salary = pSalary
End Property
Public Property Let Salary(Value As Double)
    pSalary = Value
End Property

Here is the test code:

Option Explicit

Sub test()
    Dim counter As Integer

    Dim Employees As Collection
    Dim Emp As Employee

    Dim currentEmployee As Employee


    Set Employees = New Collection

    For counter = 1 To 10
        Set Emp = New Employee

        Emp.Name = "Employee " & counter
        Emp.Address = "Address " & counter
        Emp.Salary = counter * 1000

        Employees.Add Emp, Emp.Name

    Next counter

    Set currentEmployee = Employees.Item("Employee 1")


    Debug.Print (currentEmployee.Address)

End Sub

As you can see, I'm adding items to my class specifying a key: 

Employees.Add Emp, Emp.Name

which you can then use to pull directly from without looping.

Upvotes: 1

Related Questions