Reputation: 15
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
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
Key
and Item
Column Names or Indexes. Defaults to Key on Column 1 and Item on Column 2Function 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
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