Changing array values in a VBA dictionary - excel

I have a piece of code that does not seem to do what it is expected to do. VBA Arrays are mutable by all means, but it seems that when they are stored into a Dictionary as values of some keys, they are not mutable anymore. Any ideas?
Sub foo()
Dim mydict As New Dictionary
mydict.Add "A", Array(1, 2, 3)
MsgBox mydict("A")(1)
''# The above shows 2, which is fine
mydict("A")(1) = 34
MsgBox mydict("A")(1)
''# The above also shows 2, which is not fine
End Sub

It seems you'll need yet to set another var to update the array value.
mArray = mydict.Item(1)
mArray(1) = 34
mydict.Item(1) = mArray

I created a Procedure to solve the same issue, so I could keep it as a "oneliner":
Private Sub pReplaceDicArray(Dic As Object, kEy As Variant, Element As Integer, NewValue)
Dim tempArray As Variant
tempArray = Dic(kEy)
tempArray(Element) = NewValue
Dic(kEy) = tempArray
End Sub
' call as:
' Call mReplaceDicArray(Dic, "A", 1, 8)

I would have written this answer as a comment to Mr. Irizarry's answer, but I'm not allowed. Anyway.... I tried writing that last line of code (below) to assign the array to the first item of the dictionary, but it didn't work. The array in that item remained as it was before.
mydict.items(1) = mArray
Based on what I read elsewhere, it seems to have to do with the instance of the dictionary you're calling upon. I changed it to the following line and it worked.
mydict(mydict.keys(1)) = mArray
I'm still not sure why that is the case, but there it is.

Copy the Array and update the value:
mydict("A") = Array(mydict("A")(0), 34, mydict("A")(2))

Related

Edit table function only works unpredictably

what im trying to do:
change table data if value is like the passed criteria
code:
Sub editTableData(tableName As String, rw As Integer, col As Integer, str As String)
Sheet1.ListObjects(tableName).Range(rw, col).value = str
End Sub
Sub EDITTABLEDATAONOTHERPAGE()
Call editTableData("statement", 20, 6, "Why did this work?")
End Sub
result:
03/19/2020, WAL-MART SUPERCENTER, 67.07, blank, blank, "Why did this work?"
but when called here:
Function categorize(criteria As String) As Double
Dim statement As listobject, statementNames As Range, statementCategory As Range, statementCredit As Range, name As Range
Set statement = Sheet1.ListObjects("statement")
Set statementNames = Sheet1.ListObjects("statement").ListColumns("Name").DataBodyRange
Set statementCategory = Sheet1.ListObjects("statement").ListColumns("Category").DataBodyRange
Set statementCredit = Sheet1.ListObjects("statement").ListColumns("Credit").DataBodyRange
'---this is the part that matters:--------------------------------
For Each name In statementNames
If name.value Like criteria + "*" Then
Call editTableData(statement.name, name.row, statementCategory.column, statement.name)
categorize = categorize + statementCredit(name.row, statementCredit.column).value
End If
Next
End Function
it gets to the method, it passes editTableData("statement", 20, 6, "statement") as String, int, int, String respectively (so the same data) but it just stops working and i dont know why.
anything enlightening would be nice, here is the table that i am using this table to call the formula as well:
a picture of the table
Update/amendment:
Here is the debug photos:
CALLING THE METHOD
in the method (reference locals window for values):
in the method
and when I press F8 Again this time, it crashed...
No error message, none of the other cells above or below were changed so its just not working at all. if it were an index problem that would be easy enough to fix

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.

LibreOffice Basic Ignoring “some” of my Type...End Type Definition

I'm using LibreOffice Version: 4.4.3.2 Build ID: 40m0(Build:2) Locale: en_AU
I have a Basic Module
At the top of this module before any sub or functions I have
Type InitHeadings
MySort_By As Integer
MyCharacter As Integer
MyInitiative As Integer
MyRolled As Integer
MyTotal As Integer
End Type
...
Global InitiativeColumn As New InitHeadings
But when I run a sub, set a breakpoint and 'watch' the InitiativeColumn Object only the first two fields are shown.
The rest of my code relevant to this struct as the documentation calls them is below. I don't reference it anywhere else. Can anyone tell me why the first two would work but not the rest? I have two other structs in this code and both also ignore the last three fields. Is this a Bug?
Sub Main
'Initialise Doc and Sheet Objects
Dim Doc As Object
Doc = ThisComponent
StatsSheet = Doc.Sheets.getByName("Stats")
InitiativeSheet = Doc.Sheets.getByName("Initiative")
CombatSheet = Doc.Sheets.getByName("Combat")
'LOAD HEADING NAMES
'Initiative Sheet
For Column = 0 to 25 'Columns A to Z
MyHeadingName = InitiativeSheet.getCellByPosition(Column,0).String
Select Case MyHeadingName
Case "Sort By"
InitiativeColumn.MySort_By = Column
Case "Character"
InitiativeColumn.MyCharacter = Column
Case "Initiative"
InitiativeColumn.MyInitiative = Column
Case "Rolled"
InitiativeColumn.MyRolled = Column
Case "Total"
InitiativeColumn.MyTotal = Column
End Select
Next Column
End Sub
Sub MyInitiativeButton
'Iterate over a range of cells:
For Row = 1 To 25 'Rows 2 to 26
'Column 3 is column D the "Rolled" column
InitiativeSheet.getCellByPosition(InitiativeColumn.MyRolled,Row).VALUE = Roledice(1,20,0)
Next Row
End Sub
It looks like a bug, and seems to have been reported here. The problem did not occur when I tested it in a newer version (LO 5.1.0.3).
This is only an issue for the debugger window. The values are still there:
Sub TestStructs
InitiativeColumn.MySort_By = 5
InitiativeColumn.MyCharacter = 5
InitiativeColumn.MyTotal = 5
InitiativeColumn.DoesntExist = 5
End Sub
This code works fine until the line InitiativeColumn.DoesntExist = 5, whereupon it crashes.
Now the Global problem that you mentioned in the comments is really a problem. Considering the standard programming advice that global variables are bad, I think it's wise to consider alternatives.
Instead of a subroutine, could you perhaps use a Function that returns InitiativeColumn? If not, then assigning the variable as you suggested seems a viable workaround. Personally for LO macros I prefer Python or Java since they have classes.

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.

Excel VBA - Add 1-dimensional array to multi-dimensional array without looping

I have a question regarding "creating a matrix" out of single arrays wihtout having to loop through:
From a function I get back one array with data (Return_Calc, rows = n-1). I am looking for something like
Output(n-1, j-1) = Return_Calc(Nav_Range)
At the moment, I am doing this:
Temp = Return_Calc(Nav_range)
For i = 1 To n - 1
Output(i - 1, j - 1) = Temp(i - 1)
Next i
The current option works. I was just wondering if there is another possibility without looping. Thanks for your help!
I'm not sure if you would be happy with that proposal. It presents possibility of creating Array-of-Arrays which, in some situation, would work similar to Multidimensional Array. You could consider solving your problems this way.
Here is a sample code how to create and which way you could retrieve data from final array.
Sub Array_Workaround()
Dim oneDimArrA, oneDimArrB
oneDimArrA = Array(1, 2, 3, 4)
oneDimArrB = Array("A", "B", "C", "D")
Dim multiDimArr
'creating multidemmnsional array
multiDimArr = Array(oneDimArrA, oneDimArrB)
'get element- different to standard syntax
Debug.Print multiDimArr(0)(0) '--> 1
Debug.Print multiDimArr(0)(1) '--> 2
Debug.Print multiDimArr(1)(1) '--> B
End Sub
There is one important benefit of presented solution- each internal array can have different dimension.

Resources