Excel VBA: nested dictionary issue - excel

I am not able to create a nested dictionary, assign it to a variable, overwrite one of the inner values, and then assign it to another variable without the original variable's value getting changed, which I do not want. For example, see the following code:
Option Explicit
Sub Button1_Click()
Dim d_outer As Scripting.Dictionary
Set d_outer = New Scripting.Dictionary
Dim d_inner As Scripting.Dictionary
Set d_inner = New Scripting.Dictionary
Call d_inner.Add("key", "foo")
Call d_outer.Add("first attempt", d_inner)
' Cannot use "Add", since key already exists, must use Item()
d_inner.Item("key") = "bar"
Call d_outer.Add("second attempt", d_inner)
' Print all values.
Dim v_outer As Variant
Dim v_inner As Variant
For Each v_outer In d_outer.Keys()
For Each v_inner In d_outer(v_outer).Keys()
Debug.Print "(" & v_outer & ", " & v_inner & "): '" & d_outer(v_outer)(v_inner) & "'"
Next v_inner
Next v_outer
End Sub
This produces the following output:
(first attempt, key): 'bar'
(second attempt, key): 'bar'
The first attempt's value should be foo. Why is it getting changed to bar? How do I fix this? Do I need to create a new dictionary that's an exact copy of d_inner every time I want to change only one of the values? If so, is there an easy way to do that?

In your first collection you have created a reference to an object rather than placing a value in there (for example). So as you change the inner collection it is updated in the initial outer collection.
You need to create a New object to put into the second collection. Like this:
' Cannot use "Add", since key already exists, must use Item()
Set d_inner = New Scripting.Dictionary
Call d_inner.Add("key", "bar")
Gives:
(first attempt, key): 'foo'
(second attempt, key): 'bar'
Depending on what you are trying to achieve here, you might find that classes are more flexible with these kinds of tasks

Related

How can I use cell value in declaration of new class object?

I have a fairly simple question to which I can't seem to find the answer anywhere so I'll try here. I have created a new class called "Groups" in vba. What I want to do is retrieve a value from a cell in excel and use this as the name of the new group I want to create. I've tried accessing the value through Range("B20").Value but then I need to store it in another variable first and if I do that I can't use it as the name after since it thinks I want the group to be named like my variable I stored it in.
Does anyone know a way around this? Appreciate any help or suggestions.
Below is what I've tried which doesn't work.
Dim Range("B20").Value As Group
I've also tried this but then it thinks I want to name the group as my variable "getName"
Dim getName As String
getName = Range("B20").Value
Dim getNAme As Group
Kind regards,
Jahlove
As others have suggested in the comments, you cannot change a string variable into a variable name. However, if all you want to access/reference an object using a string, you can try a Scripting.Dictionary (docs here) like this:
Sub DynamicGroupNaming()
Dim sGroupName As String
Dim dictGroups As Object
Set dictGroups = CreateObject("Scripting.Dictionary")
'Change Sheet1 to the name of your worksheet
sGroupName = ThisWorkbook.Sheets("Sheet1").Range("B20").Value
' Add a new group to the dictionary
dictGroups.Add sGroupName, New Group
' Access the group's properties/methods in the usual way
dictGroups(sGroupName).Name = sGroupName
MsgBox dictGroups(sGroupName).Name
Set dictGroups = Nothing
End Sub

Class constructor confusion - wrong number of arguments or invalid property assignment

I'm having a class module with some data:
Private sharedFolders() As String
Public Property Let SetSharedFolders(val As String)
Dim i As Integer
sharedFolders = Array("folder one", "folder two")
i = UBound(sharedFolders)
i = UBound(sharedFolders)
ReDim Preserve sharedFolders(i)
sharedFolders(i) = CStr(val)
End Property
Property Get GetSharedFolders()
GetSharedFolders = sharedFolders()
End Property
And I want to add something to this property from other module like this:
Sub PrepareData()
Dim e
Dim s
Dim a(2) As String
Set e = New Entry
a(0) = "add one"
a(1) = "add two"
For Each s In a
e.SetSharedFolders (s) 'Here comes exception
Next
For Each s In e.GetSharedFolders
Debug.Print s
Next
End Sub
But I receive an "wrong number of arguments or invalid property assignment vba" exception... Can anyone assist?
Addendum
Thanks to #AJD and #Freeflow to pointing out a mistake and idea to make it easier. Decided to make as like below.
Class Module:
Private sharedFolders As New Collection
Public Property Let SetSharedFolders(val As String)
If sharedFolders.Count = 0 Then ' if empty fill with some preset data and add new item
sharedFolders.Add "folder 1"
sharedFolders.Add "folder 2"
sharedFolders.Add CStr(val)
Else
sharedFolders.Add CStr(val)
End If
End Property
Property Get GetSharedFolders() As Collection
Set GetSharedFolders = sharedFolders
End Property
and regular module:
Sub AddData()
Dim e As New Entry ' creating an instance of a class
Dim s As Variant ' variable to loop through collection
Dim a(1) As String 'some array with data to insert
a(0) = "add one"
a(1) = "add two"
For Each s In a
e.SetSharedFolders = s
Next
For Each s In e.GetSharedFolders
Debug.Print s
Next
End Sub
Initially I thought the problem lies in this code:
i = UBound(sharedFolders)
i = UBound(sharedFolders)
ReDim Preserve sharedFolders(i)
sharedFolders(i) = CStr(val)
i is set twice to the same value, and then the sharedFolders is reDimmed to the same value it was before! Also, there is some trickery happening with the use of ix within a 0-based array.
But the problem is most likely how you have declared your variables.
For Each s In a
e.SetSharedFolders (s) 'Here comes exception
Next
s is a Variant, and a is a Variant. At this point VBA is trying to guess how to handle a For Each loop with two Variants. And then the improper call is made. The correct syntax is:
e.SetSharedFolders s '<-- no parenthesis
There are plenty of posts on StackOverflow explaining how to call routines and what the impact of the evaluating parenthesis are!
However, at this point we are only assuming it is passing in a single element of the array - it could be passing the full array itself (albeit unlikely).
And the third factor -
Public Property Let SetSharedFolders(val As String)
The parameter val is being passed ByRef and should be passed ByVal. This also has unintended side effects as I found out (Type mismatch trying to set data in an object in a collection).
Public Property Let SetSharedFolders(ByVal val As String)
All in all you have the perfect storm of ambiguity driving to an unknown result.
The answer here is to strongly type your variables. This removes about two layers of ambiguity and areas where errors can happen. In addition, this will slightly improve code execution.
Another aspect is to understand when you should pass something ByVal and when to use the default (preferably explicitly) ByRef.
And a final gratuitous hint: Use a Collection instead of an Array. Your code you have implies a Collection will be more efficient and easier to manage.
Addendum
(thanks to #FreeFlow):
If the OP changes the definition of sharedfolders to Variant rather than String() then the array statement will work as expected.
The line e.SetSharedFolders (s) will work fine if it is changed to e.SetSharedFolders = s because the method SetSharedFolders is a Let Property not a Sub. There are other errors but these two changes will make the code run.

VBA Customize collection object

I've been trying to learn how to create customized collections in Excel VBA and I found this piece of code on MSDN. While I understand most of it, can anyone tell me what the last code Set Add = empNew is doing? I don't understand it's comment. Thank you!
' Methods of the Employees collection class.
Public Function Add(ByVal Name As String, _
ByVal Salary As Double) As Employee
Dim empNew As New Employee
Static intEmpNum As Integer
' Using With makes your code faster and more
' concise (.ID vs. empNew.ID).
With empNew
' Generate a unique ID for the new employee.
intEmpNum = intEmpNum + 1
.ID = "E" & Format$(intEmpNum, "00000")
.Name = Name
.Salary = Salary
' Add the Employee object reference to the
' collection, using the ID property as the key.
mcolEmployees.Add empNew, .ID
End With
' Return a reference to the new Employee.
Set Add = empNew
End Function
You will notice that Add is the name of the Function. By issuing Set Add = newEmp your code is declaring that the return value (or object, in this case) of the function, is the newly created employee object newEmp. This means that the function will pass the variable newEmp back to its caller.
Say that you had some procedure calling your function, you would be able to do this:
Sub listEmployees
Dim e As Employee
' Create a new employee, and assign the variable e to point to this object
Set e = Add("John", 1000) ' Notice that the only reason we use "add" here is because it is the name of the function you provided
' e is now an Employee object, after being created in the line above, meaning we can access whatever properties is defined for it. The function Add lists some properties, so we can use those as examples.
Debug.Print e.Name
Debug.Print e.Salary
Debug.Print e.ID
End Sub
First, you need to define the new Type you have created, so put the following code on top of your module:
Public Type Employee
id As String
Name As String
Salary As Long
End Type
Then, inside your Public Function Add , change to Dim empNew As Employee.
Not sure why you need the following line : mcolEmployees.Add empNew, .id ??
and the last line modify to Add = empNew.
Then, when I test this Function from the following Sub:
Sub testEmp()
Dim s As Employee
s = Add("Shai", 50000)
End Sub
I get for s in the immediate window the following values:
s.id = E00001
s.Name = "Shai"
s.Salary = 50000
I hope this is what you intended in your post.

Strange behavior of range when used as key in dictionary

I have the following code:
Dim dicMyHash As Dictionary
Dim rngMyRange As Range
' A1 is empty - although the outcome is the same in any case
Set rngMyRange = Range("A1")
Set dicMyHash = New Dictionary
dicMyHash.Add Key:=rngMyRange(1), Item:=0
Debug.Print dicMyHash.Exists(rngMyRange(1).Value) ' returns False
Debug.Print rngMyRange(1) = rngMyRange(1).Value ' returns True
This behavior is somewhat unexpected. Is there some type casting going on in the background? rngMyRange(1).Value property returns a variant, whereas rngMyRange(1) is rngMyRange.item(1), which is a range. However, casting rngMyRange(1) to Variant gives the same results..
Also, adding keys is by value (so a copy of rngMyRange(1) is passed as a key). But still I cannot get why .Exists does not find the key..
Thank you in advance!
So here, we have three different values being passed around:
The original range.
Range.Value, which is a variant.
The copy of (1) which is internal to the dictionary.
If you compare these with equal signs, they are all the same. But according to Dictionary.Exists they are all different.
Why? When you use an equal sign with an object, the equal sign forces the object to call its default property. The default property of Range is Range.Value, which is why r = r.Value and also r = r.Offset(0, 0).
But for a dictionary this isn't so smart. Think about it: Every call to Dictionary.Exists would cause every object used as a key to call its default property. This can get really expensive and it can potentially trigger a lot of side effects. So instead, Dictionary.Exists tests the following:
Are you comparing an object to a non-object? Automatic fail.
Are you comparing two non-ojects? Return a = b.
Are you comparing two objects? Return a Is b.
So r is not the same as r.Value, since one is an object and the other is a non-object. And if you make a copy of r, like with r.Offset(0, 0), those are not the same either since they still point to two different objects, even if the objects have identical contents.
This, on the other hand, will work, since you will make r into the same object as d.Keys(0):
Dim d As Scripting.Dictionary
Dim r As Range
Set r = [a1]
Set d = New Dictionary
d.Add r, 0
Set r = d.Keys(0)
Debug.Print d.Exists(r)
I think the reason of your situation is that rngMyRange is recognised as an two- dimensional array and both array dimensions are passed to your dictionary.
If you change the line which adding element into Dictionary into this one:
dicMyHash.Add Key:=rngMyRange(1).value, Item:=0
it starting to work as you expect- both check points return true.
You could additionally analyse this situation in Locals Window while debugging of your code.
I'm not sure how you are putting this to use, but this will return True:
Sub test()
Dim dicMyHash As Dictionary
Dim rngMyRange As Range
Set rngMyRange = Range("A1")
Set dicMyHash = New Dictionary
dicMyHash.Add Key:=rngMyRange(1).Value, Item:=0 ' assign it with Value
Debug.Print dicMyHash.Exists(rngMyRange(1).Value)
End Sub
So then you'll have an item with a key of whatever's in A1.
I believe the reason it doesn't work without Value is that you are assigning a Range to the Key. It would make more sense to me if you were assigning the range to the Dictionary's Item.

Using multiple values field in Lotus Notes

I am trying to write a logging system for a form in Lotus Notes but I am at the part where I am not sure how I can append the information about the fields that are changed in the log fields. There are 3 fields that I use Log_Date (date), Log_User and Log_Actions (Text, allow multiple values).
I thought if I add comma to the log field it will create a new line when displaying the form but I am still getting a type mismatch on the case 2 line.
How can I append the new values to the log fields?
Sub Querysave(Source As Notesuidocument, Continue As Variant)
' Compare the values in the form after it is saved with its original values when the document is not a new document.
Dim doc As NotesDocument
Set doc = Source.Document
Dim session As New NotesSession
Dim user As String
user = session.CommonUserName
If newDoc Then
doc.Log_Date = Now()
doc.Log_User = user
doc.Log_Actions = "New document created."
Else
' Load fields value to the array
lastValues(0) = doc.QCR_No(0)
lastValues(1) = doc.QCR_Mobile_Item_No(0)
lastValues(2) = doc.QCR_Qty(0)
' Compared each value in the array to see if there is any difference
Dim i As Integer
For i = 0 To 2
If lastValues(i) <> originalValues(i) Then
Select Case i
Case 2 : doc.Log_Actions = doc.Log_Actions & "," & "Field QCR_Qty is changed"
End Select
End If
Next
End If
End Sub
doc.Log_Actions returns the notesitem. To access the value you need to use doc.Log_Actions(0)
In LotusScript back-end classes (e.g. NotesDocument, NotesItem), a multi-valued field is represented by an array with one value per element of the array. For setting the value of a field, doc.Log_Actions is shorthand (they call it 'extended syntax' in the Domino Designer help) for assigning the first (i.e., zero subscript) element of the array, but that does not work for getting the value. To get the first value, you have to use doc.Log_Actions(0). To get or set the second value, you have to use doc.Log_Actions(1).
So, your Case 2 code could look like this:
doc.Log_Actions(1) = "Field QCR_Qty is changed"
My guess, however, is that you really want to be able to continually append to the end of the list of values each time this code runs. You are also going to want your code to be robust and not blow up on you if (for any reason!) the Log_Actions item does not exist in the document. For that, you are going to want to do this:
dim actionsItem as NotesItem
if doc.hasItem("Log_Actions") then
set actionsItem = doc.getFirstItem("Log_Actions")
call actionsItem.AppendToTextList("Field QCR_Qty is changed")
end if
Or,
If (Not doc.HasItem("LogActions")) Then
doc.LogActions = "Field QCR_Qty is changed"
Else
doc.LogActions = ArrayAppend(doc.LogActions,"Field QCR_Qty is changed")
End If
This is equivalent to the NotesItem method by rhsatrhs, which you use is matter of preference.

Resources