I want to access the dictionary value "Watermelon" by using the key "first", while the dictionary is sitting within the array. I believe this is the correct method for inserting a dictionary into an array. I've tried every combination I can think of for syntax, and can't find the answer anywhere for how to access the dictionary while it's sitting in the array.
Function dictTest() As Object
Dim m_info As Dictionary
Set m_info = New Dictionary
m_info.Add "first", "watermelon"
Set dictTest = m_info
End Function
Sub checker()
Dim x(1 to 1) As Object
Set x(1) = dictTest
End Sub
This should work for you:
Function dictTest() As Object
Dim m_info As Object
Set m_info = CreateObject("Scripting.Dictionary")
m_info.Add "first", "watermelon"
Set dictTest = m_info
End Function
Sub checker()
Dim x(1 To 1) As Object
Set x(1) = dictTest
MsgBox x(1)("first")
End Sub
Related
Is there a way to call Application.Worksheetfunction.Percentile(resultColl) where resultColl is a Collection?
I tried it and it returns a Unable to get Percentile property of the WorksheetFunction class error.
EDIT:
I tried to first convert that collection to array:
Function convertToArray(resultColl As Collection)
Dim resultArray() As Variant
ReDim resultArray(1 To resultColl.Count)
Dim i As Long
For i = 1 To resultColl.Count
resultArray(i) = resultColl.Item(i)
Next
convertToArray = resultArray
End Function
and use that array inside Percentile function:
Application.WorksheetFunction.Percentile( _
convertToArray(clientsColl.Item(1).getSumLosses), 0.99)
But now it returns a wrong number of arguments or invalid property assignment error at convertToArray function, even though in this test example I created, the function works fine:
Sub testConvert() 'this works fine
Dim testColl As Collection
Set testColl = New Collection
testColl.Add "apple"
testColl.Add "orange"
testColl.Add "pineapple"
Dim tempArray() As Variant
tempArray = convertToArray(testColl)
MsgBox (tempArray(1))
End Sub
clientsColl.Item(1).getSumLosses is a Collection:
inside Client class:
Private sumLosses As Collection 'the collection of numbers, a percentile of which I need to calculate
Private Sub Class_Initialize()
Set sumLosses = New Collection
End Sub
Public Property Get getSumLosses()
Set getSumLosses = sumLosses
End Property
EDIT2:
Changed the Percentile function call to this:
Dim tempArray() As Variant
tempArray = convertToArray(clientsColl.Item(1).getSumLosses)
resultDict.Add "UL: " & _
Application.WorksheetFunction.Percentile(tempArray, 0.99)
the error occurs on the line with resultDict.
Figured it out. The adding to the dictionary was done in a wrong way:
resultDict.Add "UL: " & _
Application.WorksheetFunction.Percentile(tempArray, 0.99)
instead of
resultDict.Add "UL: ", _
Application.WorksheetFunction.Percentile(tempArray, 0.99)
I have an array that is a fixed size as a Private variable for one of my classes. Is there a way to set up a get/let property that will allow me to pass the entire array to the object, or will I have to assign the values independently? What about with a public function?
I am not sure but maybe you are talking about sth like that.
A class with the name cArray
Option Explicit
Dim mArr(1 To 5) As String
Property Get aValue() as Variant
aValue = mArr
End Property
Private Sub Class_Initialize()
mArr(1) = "Test1"
mArr(2) = "Test2"
mArr(3) = "Test3"
mArr(4) = "Test4"
mArr(5) = "Test5"
End Sub`
And for testing
Option Explicit
Sub Test()
Dim c As cArray
Dim v As Variant
Dim i As Long
Set c = New cArray
v = c.aValue
For i = LBound(v) To UBound(v)
Debug.Print v(i)
Next i
End Sub
Update: for the let part you will need a loop
Property Let aValue(nVal As Variant)
Dim i As Long
For i = LBound(nVal) To UBound(nVal)
mArr(i) = nVal(i)
Next i
End Property
I have a macro (code attached) which writes the data from two sheets into two variant arrays. It then uses a nested loop to look for all possible matches in the 2nd sheet on a piece of data in the 1st sheet.
When the first match is found one of the variant arrays appears to get wiped and I get a 'Subscript out of range'. this can happen when the data is being compared or when I subsequently try to pass data from that array to another procedure as a result of a match being found.
When I look in the Locals window, this array can change from showing the stored values to having the error message "Application-defined or object-defined error" in each index, or no indexes at all, or indexes with high negative numbers.
Regardless, if I try to investigate further while the code is in debug mode, Excel crashes ("Excel has encountered a problem and needs to close").
I have followed the advice at this link:
http://exceleratorbi.com.au/excel-keeps-crashing-check-your-vba-code/
...but to no avail.
I've stepped through the code and can trace it to the first time the data values being tested match. It happens for the same indexes (same i and j values) every time I run.
I'm using Excel 2013 on our office network.
Can anyone tell me what might be causing this or any tests I could perform to help narrow down the cause?
Could it be due to memory use? The arrays come out at about 15000 x 11 and 4000 x 6 and it's the smaller one that is being corrupted/failing.
Sub classTest()
Dim i As Long, j As Long
Dim CK_Array() As Variant, RL_Array() As Variant
Dim wb As Workbook
Dim CK_Data As Worksheet, RL_Data As Worksheet
Set wb = ThisWorkbook
Set CK_Data = wb.Sheets(1)
Set RL_Data = wb.Sheets(2)
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data) ' this sets the array that gets corrupted.
For i = 2 To UBound(CK_Array)
If Not IsEmpty(CK_Array(i, 6)) Then
For j = 2 To UBound(RL_Array)
If CK_Array(i, 6) = RL_Array(j, 4) Then ' array gets corrupted here or line below
Call matchFound(dResults, CStr(CK_Array(i, 1) & " | " & CK_Array(i, 5)), CStr(RL_Array(j, 2) & " " & RL_Array(j, 3)), CStr(RL_Array(j, 1)), CStr(RL_Array(1, 3))) ' or array gets corrupted here
End If
Next j
End If
Next i
End Sub
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
Dim endR As Long, endC As Long
Dim rng As Range
endR = ws.UsedRange.Rows.Count
endC = ws.UsedRange.Columns.Count
Set rng = Range(ws.Cells(1, 1), ws.Cells(endR, endC))
arr = rng
End Sub
EDIT:
As requested here is the code to the matchfound Sub. It's a dictionary, which holds class objects in a collection. Therefore I have also posted the class code below. I'm not yet making use of all of the class properties and methods as this issue has halted my testing.
Sub matchFound(dictionary As Object, nameCK As String, nameRL As String, RLID As String, dataitem As String)
Dim cPeople As Collection
Dim matchResult As CmatchPerson
If dictionary.exists(nameCK) Then
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
dictionary.Item(nameCK).Add matchResult
Else
Set cPeople = New Collection
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
cPeople.Add matchResult
dictionary.Add nameCK, cPeople
End If
End Sub
Class
Option Explicit
Private pName As String
Private pRLID As String
Private pMatchedOn As String
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Name As String)
pName = Name
End Property
Public Property Get RLID() As String
RLID = pRLID
End Property
Public Property Let RLID(ID As String)
pRLID = ID
End Property
Public Property Get matchedOn() As String
matchedOn = pMatchedOn
End Property
Public Property Let matchedOn(textString As String)
pMatchedOn = textString
End Property
Public Sub MatchedOnString(datafield As String)
Dim text As String
text = Me.matchedOn & "|" & datafield
Me.Name = text
End Sub
I've reduced your problem to a Minimum, Verifiable and Complete Example.
The problem occurs when you assign the implicit default value of a range to a Variant variable that was passed as a Variant array.
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
'aFoo() has now lost it's `+` sign in Locals window, but the bounds are still visible
Debug.Print aBar(1, 1)
'aFoo() has now lost its bounds in Locals Window
'aFoo(1,1) will produce subscript out of range
'Exploring the Locals Window, incpsecting variables, will crash Excel
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
'Note the use of theArray instead of theArray()
'Implicitly calling the default member is problematic
theArray = Sheet1.UsedRange
End Sub
There are a number of workarounds - I'd recommend using both:
Use Explicit calls to `Range.Value`
You can even make explicit call to the default member Range.[_Default]. The exact method isn't important, but it must be explicit.
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange.Value
End Sub
Avoid the use of `Call`, and pass common Variant definitions
Call is a deprecated statement, and can be omitted.
Declare the arrays and the helper functions' array argument consistently. That is, use () in all instances, or none.
Note the difference between declaring Dim aFoo() As Variant which is an array of Variants, and declaring Dim aFoo As Variant which is a Variant that can contain an array.
With Parentheses
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray() As Variant)
theArray = Sheet1.UsedRange
End Sub
Without Parentheses
Sub VariantArrayWTF()
Dim aBar As Variant
Dim aFoo As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange
End Sub
I have found the lines of code which were causing the problem. However, I cannot explain why it would necessarily cause a crash so I would appreciate other input on why this is happening.
When passing the RL and CK arrays to the getRange_Build Array sub I left out the brackets that would have denoted these variables as arrays.
The code was this...
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data)
...but should have been this
Call getRange_BuildArray(CK_Array(), CK_Data)
Call getRange_BuildArray(RL_Array(), RL_Data)
I'm thinking the reason that this didn't get flagged as a compile error is because the parameter in question in the getRange_BuildArray procedure itself also lacked the necessary brackets to denote an array.
It was this...
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
...it should have been this
Private Sub getRange_BuildArray(arr() As Variant, ws As Worksheet)
With those changes in place the macro is completing successfully for the full dataset and is not causing excel to crash.
As mentioned it would be great if someone could offer a more detailed breakdown of how this caused excel to crash.
How can we typecast to an interface type in VBA?
Public Function createArray(ParamArray args() As Variant) As IArray
Dim arr As IArray
Set arr = New cRwArray
Select Case UBound(args)
'No params
Case -1
'Create decorator for empty array (no action required)
'1 params
Case 0
'Return array with range values
If TypeName(args(0)) = "cRwRange" Then
'Cast type
Dim range As iRange
range = ctype(args(0), iRange) 'IRange variable not defined
Call arr.readFromRange(range)
End Select
Set createArray = arr
End Function
Edit: this is strange.
Sub test()
Dim arr As IArray
Dim range As iRange
Set range = createRange("Sheet1", 20, 30)
Set arr = createArray(range)
End Sub
Yet, the type is not correctly set.
I checked this in the factory:
Debug.Print TypeName(args(0)) 'cRwRange, not the interface type?
You don't have to explicitly cast the object, as simple assignment will work:
Set range = args(0)
Additionally, TypeName returns the declared type of an object; if you want to know whether a given object implements a specific interface, you use TypeOf:
If TypeOf range Is iRange Then
for example. Also note that range is really not a good name for a variable in Excel... :)
I'm using VBA in an application called ProcessBook and I'm looking to store some static information in a dictionary.
I'm trying to initialize this dictionary cleanly and without needing to call a separate procedure, but none of the methods I try seem to be expected.
Here's what I've tried so far:
Dim myDict As New Dictionary(Of String, String) (("key1", "item1"), ("key2", "item2"))
Dim myDict As Variant
Set myDict = New Dictionary( ("key1", "item1"), ("key2", "item2") )
And basically a bunch of guessing involving forms like that.
So far the best I've been able to do is something like:
With myDict
.add "key1", "item1"
.add "key2", "item2"
End With
But this barks at me when it's not inside of a routine, which I'd like to avoid.
I believe the (Of type, type) From { } syntax is beyond VBA 6.5
Does anyone know of some clean ways to initialize a scripting.dictionary in VBA 6.5?
By 6.5 presumably you mean VBA? If so there is no way to manipulate/initialise an object instance outside of a routine.
The only way is to encapsulate it within a class (cDict) and use the constuctor:
Private mDict As Scripting.Dictionary
Private Sub Class_Initialize()
Set mDict = New Scripting.Dictionary
With mDict
.Add "key1", "item1"
.Add "key2", "item2"
End With
End Sub
Public Property Get Dict() As Scripting.Dictionary
Set Dict = mDict
End Property
Then in the client module;
Private Dict As New cDict
Sub foo()
MsgBox Dict.Dict.Item("key1")
Dict.Dict.Add "key3", "item3"
MsgBox Dict.Dict.Item("key3")
End Sub
(Of type relates to VB.Net Generics)
VBA is really a PROCEDURAL language more then an Object Oriented Language so the answer is to use a procedure.
How to do it...
Option Explicit
Option Compare Text
Sub test()
Dim dic As New Scripting.Dictionary
Add dic, Array("Darren", 123, "Alex", 321)
MsgBox dic.Count
End Sub
Public Sub Add(dic As Dictionary, values As Variant)
If Not IsArray(values) Then
Err.Raise -1, "Add", "Values must be varient Array"
ElseIf UBound(values) Mod 2 = 0 Then
Err.Raise -1, "Add", "Even number of values required"
End If
Dim iQ As Long
For iQ = 0 To UBound(values) Step 2
dic.Add values(iQ), values(iQ + 1)
Next
End Sub