CODEWITHSUNDEEP
excelvbadictionary
Oravecz Péter
Oravecz Péter

Reputation: 15

Is there a way to create dictionaries automatically in VBA?

The snippet I included below puts the data from an Excel table into a dictionary, where the first column of the table is the file name (key) and the second column is the path to the file. The code works completely fine, however there would be several other tables that I would like to do this with, creating a bunch of dictionaries with different filenames and locations, for different purposes.

Currently I create these dictionaries separately, all of them in their own little sub. This of course means I have multiple versions of pretty much the same code: quite cumbersome.

My problem is I have no idea how I could create a dynamic number of variables to accomodate my tables. Pretty sure thats not even possible. I would appreciate some suggestions on what I could look into, what general direction is worth exploring.

Sub locationsObject()

Dim locationTable As ListObject
Dim lrow As Range
Set locationTable = ActiveSheet.ListObjects("locationTable")
Set Locations = CreateObject("Scripting.Dictionary")

'Create dictionary with locations and their names from the location table. Check if locations are valid
For Each lrow In locationTable.ListColumns(1).DataBodyRange.rows
    Locations(lrow.Value) = lrow.Offset(0, 1).Value
    'Debug.Print Locations(lrow.Value)
    'Debug.Print lrow.Value
    checkIfExists Locations(lrow.Value), "The path of " & lrow.Value & " does not exist: " & Locations(lrow.Value) & vbCrLf & "Please provide a valid path."
Next lrow

End Sub

Upvotes: 0

Views: 1019

Answers (2)

chris neilsen
chris neilsen

Reputation: 53166

Create a generalised Function, to which you pass a ListObject, together with Key and Item column names or indexes. Return a Dictionary

Something like this

  • Create new Dictionary, or append to an exisiting Dictionary
  • Optionally pass Key and Item Column Names or Indexes. Defaults to Key on Column 1 and Item on Column 2
  • includes an outline of Error Handling that you can flesh out to suit your needs
  • this is written as Early Binding. It's easily adaptable to Late Binding if you prefer
Function CreatDictionaryFromList( _
  lo As ListObject, _
  Optional Dic As Dictionary, _
  Optional Key As Variant = 1, _
  Optional Item As Variant = 2) _
As Dictionary 'Late Binding use As Object, and Optional Dic As Object

    Dim Keys As Variant, Items As Variant
    Dim idx As Long
    
    If Dic Is Nothing Then
        ' Early Binding
        Set Dic = New Dictionary
        ' Late Binding
        ' Set Dic = CreateObject("Scripting.Dictionary")
    End If
    
    On Error GoTo EH_InvalidListObject
    Keys = lo.ListColumns(Key).DataBodyRange.Value2
    Items = lo.ListColumns(Item).DataBodyRange.Value2
    
    On Error GoTo EH_InvalidKey
    For idx = LBound(Keys, 1) To UBound(Keys, 1)
        If Not Dic.Exists(Keys(idx, 1)) Then
            Dic.Add Keys(idx, 1), Items(idx, 1)
        ' Else
        ' Duplicate key.  What now?
        End If
    Next
    
    Set CreatDictionaryFromList = Dic
Exit Function
EH_InvalidListObject:
    ' ListObject is Nothing, or Table column name doesn't exist.  What now?
    Set CreatDictionaryFromList = Nothing
Exit Function
EH_InvalidKey:
    ' Invalid Key.  What now?
    Resume Next
End Function

Which you can call like this

Sub Demo()
    Dim Locations As Dictionary
    Dim lo As ListObject
    
    Set lo = ActiveSheet.ListObjects("locationTable")
    Set Locations = CreatDictionaryFromList(lo, , 1, 2)
    ' or
    ' Set Locations = CreatDictionaryFromList(lo, ,"NameOfKeyColumn", "NameOfItemColumn)
    Set lo = ActiveSheet.ListObjects("AnotherTable")
    Set Locations = CreatDictionaryFromList(lo, Locations, 1, 2)
    
    Dim i As Long
    For i = 0 To Locations.Count - 1
        Debug.Print Locations.Keys(i), Locations.Items(i)
    Next

End Sub

Upvotes: 3

Variatus
Variatus

Reputation: 14383

Here's an example of how you might set up a function that creates a dictionary from one of your tables. Pass the table to the function as an argument and assign the returned dictionary to a different variable.

Sub Main()

    Dim locationTable       As ListObject
    Dim Dict                As Object
    Dim Key                 As Variant
    
    Set locationTable = ActiveSheet.ListObjects(1)
    Set Dict = locationsObject(locationTable)
    For Each Key In Dict.Keys
        Debug.Print Key, Dict(Key)
    Next Key
End Sub

Private Function locationsObject(Tbl As ListObject) As Object

    Dim Fun         As Object           ' function return object
    Dim lrow        As Range
    Dim Locations   As Variant
    
    Set Fun = CreateObject("Scripting.Dictionary")
    
'    'Create dictionary with locations and their names from the location table.
'    'Check if locations are already in the dictionary
    For Each lrow In Tbl.DataBodyRange.Rows
        Locations = lrow.Value
        If Not Fun.Exists(Locations(1, 1)) Then
            Fun.Add Locations(1, 1), Locations(1, 2)
        End If
    Next lrow
    Set locationsObject = Fun
End Function

Observe that the loop reads each row of the table in the variable Locations and uses the first cell of that row for a Key and the second for Value. The syntax is Locations([Row], [Column]). The row is always 1 because the row only has one row. This idea is taken from your code. I'm not sure that it is what you had in mind but it can work efficiently that way.

The system can be easily modified to add items from different tables to the same dictionary, if such is your need.

Upvotes: 2

Related Questions