I have a dictionary that I want to use to store keys with dictionaries as values.
Essentially, using the below screenshot of my table of data, I want to have the dictionary (in json view) as:
{'Folder/PU01': {'PLCName':'PLCCC', 'DeviceName': 'fasasd', 'Description': '', '....'}
{'Folder/PU02': {'PLCName':'', 'DeviceName': '', 'Description': '', '....'}
etc...
I have the code below that's essentially creating this, however the very bottom line above the Next is where it's going wrong udtInstancesCurrent.Add deviceTagPath, udtInstanceParamsCurrent
This is assigning the udtInstanceParamsCurrent dictionary to the udtInstanceCurrent key, but because it's a reference to the dictionary and not a copy, it then gets overwritten the next time the loop goes around.
My question is: how can I set the value of the dictionary key in udtInstanceCurrent to a copy of the udtInstanceParamsCurrent dictionary and not a reference to the original?
Dim udtInstancesCurrent As Scripting.Dictionary
Dim udtInstanceParamsCurrent As Scripting.Dictionary
Set udtInstancesCurrent = New Scripting.Dictionary
Set udtInstanceParamsCurrent = New Scripting.Dictionary
'''' SAVE PARAMETER VALUES ''''
' For each udt instance tag path, add its param value into a dictionary to save its values
For Each udtTagPathCell In Range(.Cells(INSTANCES_ROW_HEADERS + 1, INSTANCES_COL_UDTTAGPATH), .Cells(INSTANCES_ROW_HEADERS, INSTANCES_COL_UDTTAGPATH).End(xlDown))
udtTagPath = udtTagPathCell.Value
deviceName = .Cells(udtTagPathCell.Row, INSTANCES_COL_DEVICENAME)
deviceParentPath = .Cells(udtTagPathCell.Row, INSTANCES_COL_DEVICEPARENTPATH)
deviceTagPath = deviceParentPath & "/" & deviceName
Row = udtTagPathCell.Row
udtInstanceParamsCurrent.RemoveAll
' For each parameter defined, add into a dictionary
For Each param In Range(.Cells(Row, INSTANCES_COL_PARAMSSTART), .Cells(Row, .Cells(INSTANCES_ROW_HEADERS, 1).End(xlToRight).Column))
paramName = .Cells(INSTANCES_ROW_HEADERS, param.Column)
udtInstanceParamsCurrent.Add paramName, param.Value
Next
' TODO: Dictionary is being overwritten. need to set this to a new instance of the dictionary
udtInstancesCurrent.Add deviceTagPath, udtInstanceParamsCurrent
Next
I worked it out.. I just need to set the udtInstanceParamsCurrent to a new dictionary within the for loop instead of outside of it.
Dim udtInstancesCurrent As Scripting.Dictionary
Dim udtInstanceParamsCurrent As Scripting.Dictionary
Set udtInstancesCurrent = New Scripting.Dictionary
'''' SAVE PARAMETER VALUES ''''
' For each udt instance tag path, add its param value into a dictionary to save its values
For Each udtTagPathCell In Range(.Cells(INSTANCES_ROW_HEADERS + 1, INSTANCES_COL_UDTTAGPATH), .Cells(INSTANCES_ROW_HEADERS, INSTANCES_COL_UDTTAGPATH).End(xlDown))
Set udtInstanceParamsCurrent = New Scripting.Dictionary
udtTagPath = udtTagPathCell.Value
deviceName = .Cells(udtTagPathCell.Row, INSTANCES_COL_DEVICENAME)
deviceParentPath = .Cells(udtTagPathCell.Row, INSTANCES_COL_DEVICEPARENTPATH)
deviceTagPath = deviceParentPath & "/" & deviceName
Row = udtTagPathCell.Row
udtInstanceParamsCurrent.RemoveAll
' For each parameter defined, add into a dictionary
For Each param In Range(.Cells(Row, INSTANCES_COL_PARAMSSTART), .Cells(Row, .Cells(INSTANCES_ROW_HEADERS, 1).End(xlToRight).Column))
paramName = .Cells(INSTANCES_ROW_HEADERS, param.Column)
udtInstanceParamsCurrent.Add paramName, param.Value
Next
' TODO: Dictionary is being overwritten. need to set this to a new instance of the dictionary
udtInstancesCurrent.Add deviceTagPath, udtInstanceParamsCurrent
Next
Related
I want to set a dictionary as dictionary value?
But it throws an error like
'Wrong number of arguments or invalid property assignment'.
How to fix this issue?
sub test()
Dim Dict As Scripting.Dictionary
Set Dict = New Scripting.Dictionary
Dim rows As Scripting.Dictionary
Set rows = New Scripting.Dictionary
dict("name") = "Sarah"
dict("surname") = "Jones"
rows(dict("name")) = dict
end sub
Dictionary is an object type, with a default member.
rows(dict("name")) = dict
The RHS of this assignment is really a call to dict.Item, but invoked without any parameters... but the Key parameter is required - hence the error.
The Set keyword disambiguates default member calls from "yes I really mean the object reference itself"
Set rows(dict("name")) = dict
It works, but I don't know how:
I want to create a dynamic number of classes, so I use a dictionary for that.
But I can't add a key to each class of the dictionary.
It works when I add each entry of the 1st dictionary to a second dictionary as a couple item/key.
sub test()
Dim dict As New Dictionary
Dim dict2 As New Dictionary
For i = 1 To 2
Set dict(i) = New Cfgadress
dict(i).Col1 = i
dict2.Add "d" & i, dict(i)
Next i
Debug.Print dict2("d1").Col1
Debug.Print dict2("d2").Col1
End Sub
That was a guess and I'm not sure I understand how it works : is the entry of the first dictionary a class object, while the entry of the second dictionary is a dictionary object (couple item/key) ?
No need for the second dictionary. What's the error you're getting with using just one?
Here is my working code:
Add Module: Module1
Sub test()
Dim col1 As Dictionary
Dim classInstance As Class1
Dim counter As Long
' Init the collection
Set col1 = New Dictionary
For counter = 1 To 2
' Set new instance of class
Set classInstance = New Class1
' Set properties in new class instance
classInstance.testfield = "Test value" & counter
' Add it to the collection
col1.Add "test" & counter, classInstance
Next counter
Debug.Print col1.Item("test1").testfield
Debug.Print col1.Item("test2").testfield
End Sub
Class: Class1
Public testfield As String
I think I get it, correct me if I'm wrong.
When I create a dictionary entry with
Set dict(i) = New Cfgadress
It creates a new dictionary entry: blank object of class Cfgadress associated to the key i
Dict(i) refers to the item contained in entry i of the dictionary dict, i.e. to the class object contained.
To change the key, I need to assign a new couple item/key, but the item exists only as entry i of the dictionnary. So I need either :
to use the entry of the dictionary as an item associated with a key in a new dictionary/collection/array (what I did in my code)
or to assign dict(i) to an object, add it to the with a correct key and remove the former one.
Set object as New class
Set object=dict(i)
dict.Add "key", object
dict.remove "1"
Did I get it ?
Your solution is way simpler and that's what I tried first, but I went to dynamic dictionary because on each iteration, updating the class instance was also updating the previous entries of the collection
Set Wb = ThisWorkbook '==================
Set WsCfg = Wb.Sheets("Cfg") '==================
Dim dict_cfg As New Dictionary
Dim coll As New Collection
Set tcfg_adress = New Cfgadress
For i = 3 To 4 '22
If WsCfg.Cells(i, 10) = 1 And WsCfg.Cells(i, 11) = 1 Then
tcfg_adress.Row1 = WsCfg.Cells(i, 4).Value
tcfg_adress.Col1 = WsCfg.Cells(i, 5).Value
tcfg_adress.Lrow = WsCfg.Cells(i, 6).Value
tcfg_adress.Lcol = WsCfg.Cells(i, 7).Value
tcfg_adress.Nbrow = WsCfg.Cells(i, 8).Value
tcfg_adress.Nbcol = WsCfg.Cells(i, 9).Value
coll.Add tcfg_adress, WsCfg.Cells(i, 1)
End If
Next i
Turns out that setting a new class instance in each loop, as I saw you did in your code, solved my problem. I thought there was nothing to do and was investigating in get arounds. Thanks a lot !
I want to set a dictionary as dictionary value?
But it throws an error like
'Wrong number of arguments or invalid property assignment'.
How to fix this issue?
sub test()
Dim Dict As Scripting.Dictionary
Set Dict = New Scripting.Dictionary
Dim rows As Scripting.Dictionary
Set rows = New Scripting.Dictionary
dict("name") = "Sarah"
dict("surname") = "Jones"
rows(dict("name")) = dict
end sub
Dictionary is an object type, with a default member.
rows(dict("name")) = dict
The RHS of this assignment is really a call to dict.Item, but invoked without any parameters... but the Key parameter is required - hence the error.
The Set keyword disambiguates default member calls from "yes I really mean the object reference itself"
Set rows(dict("name")) = dict
First of all I want so say sorry for not showing any code but right now I need some guidelines on how to take out a unique ID of a string.
So I have some problems of how to organize data. Lets say that the data is organized so that each dataID has their unique name. I collect the data into a array that holds it.
The problem I now have is that I want a easy way to search for these nameID. Imagine that the data is a lot bigger and contain more than a few hundred of different unique combinations of nameID's. Therefor I do not think searching for the id itself would be appropriate and I'm thinking of creating an hash that I could use an algorithm on to search the array. I want to do this because later on I will compare the names and add the values to the respective nameID. Keep in mind that the nameID will most of the time have the same structure but eventually a new name like total_air could be implemented and then I need to search in the array to get right value.
Updated:
Example of an code that collect the data from excel:
For Each targetSheet In wb.Worksheets
With targetSheet
'Populate the array
xData(0) = Application.Transpose(Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Value2)
cnt = UBound(xData(0))
End With
Call dData.init(cnt)
'Populate the objectarray
dData.setNameArray = xData(0)
Next targetSheet
Type object:
Private index As Integer
Private id As String
Private nameID() As Variant
Private data() As Variant
Private cnt As Integer
Public Sub init(value As Integer)
index = 0
cnt = value
id = ""
ReDim nameID(0 To cnt)
ReDim data(0 To cnt)
End Sub
Property Let setID(value As String)
id = value
End Property
Property Let setNameArray(value As Variant)
nameID = value
End Property
dList that inherit the dataStruct:
Private xArray() As dataStruct
Private listInd As Integer
Public Sub init(cnt As Integer)
ReDim xArray(1 To cnt)
Dim num As Integer
For num = 1 To cnt
Set xArray(num) = New dataStruct
Next
listInd = 1
End Sub
Property Let addArray(value As dataStruct)
Set xArray(listInd) = value
listInd = listInd + 1
End Property
How the hole list will look like:
I would strongly advocate using a dictionary. Not only is it much faster to find an item (I would assume that it is implemented with some kind of hashing), it has big advantages when it comes to adding or removing items.
When you have an array and want to add an item, you either have always to use redim preserve which is really expensive, or you define the array larger than initially needed and always have to keep the information how many items are really used. And deleting an item from an array is rather complicated.
You cannot add a typed variable as item value into a dictionary, but you can add a object. So instead of your Type definition, create a simple class module, containing only these lines (of course you can create the class with properties, getter and setter but that's irrelevant for this example)
Public id As Long
Public name As String
Public value As Long
Then, dealing with the dictionary is rather simple (note that you have to add a reference to the Microsoft Scripting Runtime
Option Explicit
Dim myList As New Dictionary
Sub AddItemValues(id As Long, name As String, value As Long)
Dim item As New clsMyData
With item
.id = id
.name = name
.value = value
End With
Call AddItem(item)
End Sub
Sub AddItem(item As clsMyData)
If myList.Exists(item.id) Then
set myList(item.id) = item
Else
Call myList.Add(item.id, item)
End If
End Sub
Function SearchItem(id As Long) As clsMyData
If myList.Exists(id) Then
Set SearchItem = myList(id)
Else
Set SearchItem = Nothing
End If
End Function
Function SearchName(name As String) As clsMyData
Dim item As Variant
For Each item In myList.Items
If item.name = name Then
Set SearchName = item
Exit Function
End If
Next item
Set SearchName = Nothing
End Function
So as long as you deal with Id's, the dictionary will do all the work for you. Only if you search for the name, you have to loop over all items of the dictionary, which is as easy as looping over an array.
Some test (of course you should add some error handling)
Sub test()
Call AddItemValues(32, "input_air", 0)
Call AddItemValues(45, "air_Procent", 99)
Call AddItemValues(89, "output_air", 34)
Debug.Print SearchItem(45).name
Debug.Print SearchName("output_air").value
' Change value of output_air
Call AddItemValues(89, "output_air", 1234)
Debug.Print SearchName("output_air").value
End Sub
Im copying cells from one sheet to another, finding and matching column header names and pasting to the correct cell. These column header names differ slightly per sheet, altough they contain the same data. My working code has a lot of repetition:
' sub that finds head in a specified worksheet and sets rngCol variable
Sub rngByHead(Sheet As Worksheet, head As String)
' sub for copying data
With Source1
' find and set producer, note name difference)
Call rngByHead(Source1, "bedrijfsnaam")
Dim producent As String
producent = .Cells(docSource1.Row, rngCol).Value
' find and set Fase
Call rngByHead(Source1, "Fase")
Dim fase As String
fase = .Cells(docSource1.Row, rngCol).Value
' find and set Status
Call rngByHead(Source1, "Status")
Dim status As String
status = .Cells(docSource1.Row, rngCol).Value
' find and set versionnumber, note name difference
Call rngByHead(Source1, "Wijziging")
Dim versienummer As String
versienummer = .Cells(docSource1.Row, rngCol).Value
End With
With Target
' find and write all variables to uploadlijst
Call rngByHead(Target, "bestandsnaam")
.Cells(cell.Row, rngCol).Value = bestand
Call rngByHead(Target, "producent")
.Cells(cell.Row, rngCol).Value = producent
Call rngByHead(Target, "fase")
.Cells(cell.Row, rngCol).Value = LCase(fase)
Call rngByHead(Target, "status")
.Cells(cell.Row, rngCol).Value = LCase(status)
Call rngByHead(Target, "versienummer")
.Cells(cell.Row, rngCol).Value = versienummer
End With
I was trying a more cleaner option with a dictionary for matching the different header names in target and data sheets. I also created a secong dictionary to store those values under the specific keys. I keep getting errors on this code, both 424 object missing as ByRef argument type mismatch.
' Create dict
Dim dict As Scripting.Dictionary
' Create dictValues
Dim dictValues As Scripting.Dictionary
Dim key As Object
' Add keys to dict
dict("producent") = "Bedrijfsnaam"
dict("fase") = "Fase"
dict("status") = "Status"
dict("versienummer") = "Wijziging"
dict("documentdatum") = "Datum"
dict("omschrijving1") = "Omschrijving 1"
dict("omschrijving2") = "Omschrijving 2"
dict("omschrijving3") = "Omschrijving 3"
dict("discipline") = "Discipline"
dict("bouwdeel") = "Bouwdeel"
dict("labels") = "Labels"
' store values of sheet Source 1
With Source1
' create second dictValues to store values for each key
Set dictValues = New Scripting.Dictionary
' loop through keys in dict, this line gives error 424
For Each key In dict.Keys
' use dict to pass right value to rngByHead sub
Call rngByHead(Target, dict(key))
' store value of cell to dictValues under same key
dictValues(key) = .Cells(cell.Row, rngCol).Value
Next key
End With
' set values to sheet Target
With Target
' loop through keys in dict
For Each key In dict.Keys
' use dict to pass value of key item to rngByHead sub
Call rngByHead(Target, key)
' set value of cell to dictValues
.Cells(cell.Row, rngCol).Value = dictValues(key)
Next key
End With
What am I doing wrong? I'm new to vba dictionary and can't figure this one out. Thanks for your help!
Try like this:
Dim dict As New Scripting.Dictionary
Dim dictValues As New Scripting.Dictionary
The keyword New initializes an object from type Scripting.Dicitionary. Without it, no new object is initialized, just an object of type Scripting.Dictionary is declared. This is called early binding in VBA. See a bit here - What is the difference between Early and Late Binding?
I fixed it! Posting the code here on Stackoverflow for future reference. It turned out to be very simple, my dictionary was working fine. The key or k variable was set as Variant or Object, so it didn't pass it's value correctly as String to the rngByHead sub. Converting the k to str as String did the trick.
'sub that finds head in a specified worksheet and sets rngCol variable
Sub rngByHead(Sheet As Worksheet, head As String)
'setting up dictionary
Dim dict As New Scripting.Dictionary
Dim dictValues As New Scripting.Dictionary
Dim k As Variant
Dim str As String
'create dictionary
Set dictValues = New Scripting.Dictionary
Set dict = New Scripting.Dictionary
'add keys to dict
dict("producent") = "Bedrijfsnaam"
dict("fase") = "Fase"
dict("status") = "Status"
dict("versienummer") = "Wijziging"
dict("documentdatum") = "Datum"
dict("omschrijving1") = "Omschrijving"
dict("omschrijving2") = "Omschrijving 2"
dict("omschrijving3") = "Omschrijving 3"
dict("discipline") = "Discipline"
dict("bouwdeel") = "Bouwdeel"
dict("labels") = "Labels"
'store values of sheet Source 1
With Source1
'find and set variables using dictionary
'creating array of keys
keys = dict.keys
For Each k In keys
Call rngByHead(Source1, dict(k))
dictValues(k) = .Cells(docSource1.Row, rngCol).Value
Next
End With
With Target
'find and write variables using dictionary
For Each k In keys
'converting k as Variant to str as String
str = k
Call rngByHead(Target, str)
.Cells(cell.Row, rngCol).Value = dictValues(k)
Next
End With
Another note: you have to enable Microsoft Scripting Runtime in microsoft visual basic code editor under Tools > References.
Provided a user has enabled the option Trust Access to the VBA Project object model in File -> Options -> Trust Center -> Trust Center Setttings -> Macro Settings. You can run this code and enable the Microsoft Scripting Runtime reference:
Sub Test()
Dim Ref As Object, CheckRefEnabled%
CheckRefEnabled = 0
With ThisWorkbook
For Each Ref In .VBProject.References
If Ref.Name = "Scripting" Then
CheckRefEnabled = 1
Exit For
End If
Next Ref
If CheckRefEnabled = 0 Then
.VBProject.References.AddFromGUID "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0
End If
End With
End Sub