I have a Client class. Inside that class there is an array losses. First I create and populate with clients a clientsColl array. Then for each client in that array I populate its losses array.
Then I try to print into debug a first element of losses for each client. However, it doesnt work and Property let procedure not defined and property get procedure did not return an object error appears.
And the same time if I just try to display a first element of losses for the first client, without any cycle, it works fine:
Dim clientsColl() As Client
clientsColl = getClients(dataWorkbook)
Dim clientCopy As Variant
Debug.Print "first: " & clientsColl(1).getLosses(1) 'works fine
For Each clientCopy In clientsColl
Debug.Print "in for each: " & clientCopy.getLosses(1) 'error here
Next
In Client class:
Public Property Get getLosses()
getLosses = losses
End Property
Private losses() As Double
How the losses array is populated:
Public Sub calculateFinancialResult()
ReDim losses(1 To simulationCount)
ReDim profits(1 To simulationCount)
Dim i As Long
For i = 1 To simulationCount
If outcomes(i) = 1 Then
losses(i) = totalLoss
...
Else
...
End If
Next
End Sub
Why does this happen and how to fix it?
EDIT: more of the main sub:
For Each clientCopy In clientsColl
clientCopy.setSimulationCount = globals("SIMULATION_COUNT")
...
clientCopy.calculateFinancialResult
...
Next
EDIT:
At the same time a simple for cycle works fine:
Debug.Print "first: " & clientsColl(1).getLosses(1)
For tempCount = LBound(clientsColl) To UBound(clientsColl)
Debug.Print "in for each: " & _
clientsColl(tempCount).getLosses(1)
Next
To conclude what was said in comments:
Your problem (error 451) often occures when you trying to compound properties.
To represent this case we can use any structure of any object with properties.
Let's emulate it with array of collections:
Option Explicit
Sub Test()
Dim Arr As Variant
Dim Col As Collection
Dim i As Long
Dim j As Long
ReDim Arr(1 To 10)
For i = 1 To 10
Set Col = New Collection
For j = 1 To 10
Call Col.Add(j)
Next
Set Arr(i) = Col
Next
On Error Resume Next
Debug.Print Arr(1).Item(1)
Debug.Print Arr(1).Item()(1)
On Error GoTo 0
End Sub
Your problem stems from the fact that you're treating your properties as attributes. On not-so-compounded (or when your array is declared explicitly as array of class instances) level it works due to early binding. But when things start to get more complex - it's fail, since your property just another function.
Hence, to achieve what you want, you should call it explicitly with another pair of parentheses.
Your getLosses property doesn't take an argument so your syntax is actually wrong, even though VBA can cope with it when early bound. You should be using:
Debug.Print "first: " & clientsColl(1).getLosses()(1) 'works fine
For Each clientCopy In clientsColl
Debug.Print "in for each: " & clientCopy.getLosses()(1) 'error here
Next
I also meet this problem when I create my customize array class using compound properties.
I solved it by adding class statment for return value in Property Get code. Just as what #Rory said.
You could try Public Property Get getLosses() As Double in the Client class.
Related
I have an array of combinations called "Keys". I want to check if each combination exists in the column I, and if so, split the existing combination in 2 strings and add them as a pair in my dictionary "combiExist".
My code throws a 457 error
Dim combiExist As Object
Set combiExist = CreateObject("Scripting.Dictionary")
For Each cle In keys
'If combination exists in my range
If Not .Range("I:I").Find(cle) Is Nothing Then
'Split string from 7th position, left part is the key, right part is the value
combiExist.Add Left(cle, 7), Right(cle, 7)
End If
Next
How can I solve this ?
Error 457 says that the key is already associated with an element of the collection. So, before assigning it to the dictionary make sure it is not there, with .Exists.
This one works rather ok, at the end it prints the dictionary:
Sub Main()
Dim combiExist As Object
Set combiExist = CreateObject("Scripting.Dictionary")
Dim combinations As Variant
combinations = Array("joeC12345678910", "C12345678910", "foooooo123")
Dim cle As Variant
For Each cle In combinations
If Not Worksheets(1).Range("I:I").Find(cle) Is Nothing Then
If combiExist.exists(Left(cle, 7)) Then
Debug.Print "Do nothing this one " & (Left(cle, 7)) & " exists!"
Else
combiExist.Add Left(cle, 7), Right(cle, 7)
End If
End If
Next
PrintDictionary combiExist
End Sub
Public Sub PrintDictionary(myDict As Object)
Dim key As Variant
For Each key In myDict.keys
Debug.Print key; "-->"; myDict(key)
Next key
End Sub
In general, do not use words like Keys for a variable name, because this one means something in VBA - usually a collection of the keys of a given dictionary. You can see the implementation of myDict.keys in PrintDictionary().
Beware of voodoo programming
Do
If Inp.AtEndOfStream = True then exit do
Line=Inp.readline
On Error Resume Next
Dict.Add(Line, "")
If err.number = 457 then err.clear
On Error Goto 0
Loop
This is the way one programs. One does and handles it.
The answers given using .exists generates needless function calls. All methods and properties are indirect function calls under the hood. That means stack setup and tear down. There will be a minimum of one function per item, if it's duplicated. But there will be two function calls for unique items.
Testing return values it is only one function per item.
Also remember every . is also a function call.
Remember COM methods/properties look like this
Err.Number = MethodName(Param1, ..., ReturnValue)
Err.Number, called an HResult in COM, returns information about your call.
Embrace errors.
What is on the stack.
The return address, the return value, any parameters (in or out), and all local variables.
In the other answer there is a minimum of 3 function calls or 4 if it does not exists.
My Code is 2 if it exists or not. That is multiplied by the number of items.
I am currently creating a Class Object for a VBA file, its objective is to act as a range dictionary that can be passed single cells. If this cell is contained in one of the ranges, it returns the value associated to the corresponding range key. The class name is "rangeDic".
It is in the making so its functionalities are not implemented yet. Here's the code:
Private zone() As String
Private bounds() As String
Private link As Dictionary
Const ContextId = 33
'Init zone
Private Sub Class_Initialize()
Set link = New Dictionary
ReDim zone(0)
ReDim bounds(0)
End Sub
'properties
Property Get linkDico() As Dictionary
Set linkDico = link
End Property
Property Set linkDico(d As Dictionary)
Set link = d
End Property
Property Get pZone() As String()
pZone = zone
End Property
Property Let pZone(a() As String)
Let zone = a
End Property
'methods
Public Sub findBounds()
Dim elmt As String
Dim i As Integer
Dim temp() As String
i = 1
For Each elmt In zone
ReDim Preserve bounds(i)
temp = Split(elmt, ":")
bounds(i - 1) = temp(0)
bounds(i) = temp(1)
i = i + 2
Next elmt
End Sub
I was trying to instanciate it in a test sub in order to debug mid conception. Here's the code:
Sub test()
Dim rd As rangeDic
Dim ran() As String
Dim tabs() As Variant
Dim i As Integer
i = 1
With ThisWorkbook.Worksheets("DataRanges")
While .Cells(i, 1).Value <> none
ReDim Preserve ran(i - 1)
ReDim Preserve tabs(i - 1)
ran(i - 1) = .Cells(i, 1).Value
tabs(i - 1) = .Cells(i, 3).Value
i = i + 1
Wend
End With
Set rd = createRangeDic(ran, tabs)
End Sub
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
Dim obje As Object
Dim zonesL As Integer
Dim valsL As Integer
Dim i As Integer
zonesL = UBound(zones) - LBound(zones)
valsL = UBound(vals) - LBound(vals)
If zonesL <> valsL Then
Err.Raise vbObjectError + 5, "", "The key and value arrays are not the same length.", "", ContextId
End If
Set obje = New rangeDic
obje.pZone = zones()
For i = 0 To 5
obje.linkDico.add zones(i), vals(i)
Next i
Set createRangeDic = obje
End Function
Take a look at line 2 of Public Function createRangeDic. I have to declare my object as "Object", if I try declaring it as "rangeDic", Excel crashes at line obje.pZone = zones(). Upon looking in the Windows Event Log, I can see a "Error 1000" type of application unknown error resulting in the crash, with "VB7.DLL" being the faulty package.
Why so ? Am I doing something wrong ?
Thanks for your help
Edit: I work under Excel 2016
It looks like this is a bug. My Excel does not crash but I get an "Internal Error".
Let's clarify a few things first, since you're coming from a Java background.
Arrays can only be passed by reference
In VBA an array can only be passed by reference to another method (unless you wrap it in a Variant). So, this declaration:
Property Let pZone(a() As String) 'Implicit declaration
is the equivalent of this:
Property Let pZone(ByRef a() As String) 'Explicit declaration
and of course, this:
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
is the equivalent of this:
Public Function createRangeDic(ByRef zones() As String, ByRef vals() As Variant) As rangeDic
If you try to declare a method parameter like this: ByVal a() As String you will simply get a compile error.
Arrays are copied when assigned
Assuming two arrays called a and b, when doing something like a = b a copy of the b array is assigned to a. Let's test this. In a standard module drop this code:
Option Explicit
Sub ArrCopy()
Dim a() As String
Dim b() As String
ReDim b(0 To 0)
b(0) = 1
a = b
a(0) = 2
Debug.Print "a(0) = " & a(0)
Debug.Print "b(0) = " & b(0)
End Sub
After running ArrCopy my immediate window looks like this:
As shown, the contents of array b are not affected when changing array a.
A property Let always receives it's parameters ByVal regardless of whether you specify ByRef
Let's test this. Create a class called Class1 and add this code:
Option Explicit
Public Property Let SArray(ByRef arr() As String)
arr(0) = 1
End Property
Public Function SArray2(ByRef arr() As String)
arr(0) = 2
End Function
Now create a standard module and add this code:
Option Explicit
Sub Test()
Dim c As New Class1
Dim arr() As String: ReDim arr(0 To 0)
arr(0) = 0
Debug.Print arr(0) & " - value before passing to Let Property"
c.SArray = arr
Debug.Print arr(0) & " - value after passing to Let Property"
arr(0) = 1
Debug.Print arr(0) & " - value before passing to Function"
c.SArray2 arr
Debug.Print arr(0) & " - value after passing to Function"
End Sub
After running Test, my immediate window looks like this:
So, this simple test proves that the Property Let does a copy of the array even though arrays can only be passed ByRef.
The bug
Your original ran variable (Sub test) is passed ByRef to createRangeDic under a new name zones which is then passed ByRef again to pZone (the Let property). Under normal circumstances there should be no issue with passing an array ByRef as many times as you want but here it seems it is an issue because the Property Let is trying to make a copy.
Interestingly if we replace this (inside createRangeDic):
obje.pZone = zones()
with this:
Dim x() As String
x = zones
obje.pZone = x
the code runs with no issue even if obje is declared As rangeDic. This works because the x array is a copy of the zones array.
It looks that the Property Let cannot make a copy of an array that has been passed ByRef multiple times but it works perfectly fine if it was passed ByRef just once. Maybe because of the way stack frames are added in the call stack, there is a memory access issue but difficult to say. Regardless what the problem is, this seems to be a bug.
Unrelated to the question but I must add a few things:
Using ReDim Preserve in a loop is a bad idea because each time a new memory is allocated for a new (larger) array and each element is copied from the old array to the new array. This is very slow. Instead use a Collection as
#DanielDuĊĦek suggested in the comments or minimize the number of ReDim Preserve calls (for example if you know how many values you will have then just dimension the array once at the beginning).
Reading a Range cell by cell is super slow. Read the whole Range into an array by using the Range.Value or Range.Value2 property (I prefer the latter). Both methods returns an array as long as the range has more than 1 cell.
Never expose a private member object of a class if that object is responsible for the internal workings of the class. For example you should never expose the private collection inside a custom collection class because it breaks encapsulation. In your case the linkDico exposes the internal dictionary which can the be modified from outside the main class instance. Maybe it does not break anything in your particular example but just worth mentioning. On the other hand Property Get pZone() As String() is safe as this returns a copy of the internal array.
Add Option Explicit to the top of all your modules/classes to make sure you enforce proper variable declaration. Your code failed to compile for me because none does not exist in VBA unless you have it somewhere else in your project. There were a few other issues that I found once I turned the option on.
Is there anyway that I can put various classes into an array so that instead of hard-coding like:
set var1 = new cls1
set var2 = new cls2
we can do:
varArr = array ( var1, var2...)
clsArr = array (cls1, cls2...)
and now I just loop thru varArr and clsArr to set new class accordingly, like:
sub setNew(x as double)
set varArr(x) = new clsArr(x)
end sub
I did try but it didn't work, please help me out
Thank you very much !
Triet (mr)
I try, but my knowledge also limited.
First of all I do not think you can put class into an array. You can put objects. I also failed to use the array() function.
Please see how I proceeded with some demonstration:
This is the class module, containing a value, the property and a primitive print sub:
Private nr As Integer 'Use as identification
Sub cPrint()
MsgBox "Object ID: " & nr
End Sub
Property Let ID(v As Integer)
nr = v
End Property
In the module in the first cycle I create the object, put the ID value. In the second one all ID values are printed. I hope you can use it for your purposes.
Sub clsTest()
Dim varArr(1 To 5) As cls1
Dim i As Integer
For i = 1 To 5
Set varArr(i) = New cls1
varArr(i).ID = i
Next
For i = 1 To 5
varArr(i).cPrint
Next
End Sub
I am having a very strange problem. I am not able to get the value returned from a simple function as below if the return value is more than one char. Now the second problem is that following code is not assigning "WTH" to sheetName variable. Refer to the screenshot 2. UPDATED AFTER CYRIL'S COMMENTS
Public Sub WTHFormatter()
Dim sheetName As String
sheetName = "WTH"
Dim rng1 As Range
'delete empty rows
lastRowWTH = getLastRow(sheetName, 2)
'Delete rows below the last Row
Worksheets(sheetName).Rows(lastRowWTH + 1 & ":" & Worksheets(sheetName).Rows.Count).Delete
' build first range
Set rng1 = Worksheets(sheetName).Range("B11:F" & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range("H11:K" & lastRowWTH)
Call setCellBorders(rng1)
'determine the range for months
For i = 13 To 24
If Cells(7, i) = "" Then
lastCol = i - 1
Exit For
End If
lastCol = i
Next
ColLetter = returnLabel(lastCol)
ColLetter2 = returnLabel(lastCol + 2)
ColLetterX = returnLabel(lastCol + 14)
Set rng1 = Worksheets(sheetName).Range("K17:" & ColLetter & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range(ColLetter2 & lastRowWTH & ":" & ColLetter3 & lastRowWTH)
Call setCellBorders(rng1)
End Sub
Function returnLabel(num1 As Long) As String
Dim ColumnLetter As String
ColumnLetter = Split(Cells(1, num1).Address, "$")(1)
returnLabel = ColumnLetter
End Function
The above function returns blank and varTest has nothing after the execution. If I do the line by line execution, I see that test1 in function is not 'Null'.
If I break the execution and probe the variables I see "test1 =" only as per the screen shot below. And this is breaking my code.
Strangely, If I call the function from 'Immediate Window', it returns the expected value.
Things I have already done:
I have tested in a fresh file using simple code as above.
Tested in different PC and the same code is working fine with same version of Windows 10 & Office 365.
Updated / Re-installed MS Office 365
Restarted the PC
If the return value is a single character like "A", the code is working fine.
Failed to understand the reason here. Any help is appreciated.
UPDATE1
I tried it on a fresh file while the code above worked, but the main code is having a new similar problem. This has started happening just now. It's not assigning a string value to the variable. See the attached screenshot.Screenshot of the VBA Code. I am assuming there is some problem with system or some virus.
If the idea is to have a function, that an array, this is possible with the following code:
Function Test1() As Variant
ReDim result(2)
result(0) = "AJ"
result(1) = "A"
Test1 = result
End Function
Sub Main()
Dim varTest As Variant
varTest = Test1(0)
Debug.Print varTest
varTest = Test1(1)
Debug.Print varTest
End Sub
It is questionable why would it be needed, but as a "test-exercise" it is ok.
Going to put my comments into an answer to consolidate and add more explanation.
Pointing out some errors in the code before correcting:
Function test1(num1) 'declare `as variant` to ensure you're returning an array
test1 = "AJ" 'this appears to be saving a single string to var test1
test1 = "A" 'you are now overwriting the above string
End function
Sub test()
varTest = test1(1) 'you have a single string from the function and arrays start at 0, not 1
End sub
You would want to specify the place in the array, after declaring an array, within your function such that:
Function test1() As Variant
Dim arr(2) As Variant 'added array because test1 = BLAH is the final output in a function
arr(0) = "AJ" 'added (1) to call location in array
arr(1) = "A" 'added (2) to call location in array
test1 = arr
End Function
Sub test()
Dim varTest As Variant
varTest = test1(0) 'outputs "AJ" in immediate window
Debug.Print varTest
End Sub
Now you can debug.print your array values, or set to varTest based on the location in the array.
Edit: Tested after my consolidating comments and recognized that there was not an actual output for test1 as an array at the end of the function, so had to go back and add a second array to set test = allowing an array output from a function.
Your code is running as it should.
The test1 function assigns the value AJ to the test1 variable, and then it assigns the value A to the test1 variable.
You could assign the value 50 in your test procedure and it will return A.
I think this is the code you're after:
Function test1(num1) As String
' Dim MyArray As Variant
' MyArray = Array("AJ", "A")
'OR
Dim MyArray(0 To 1)
MyArray(0) = "AJ"
MyArray(1) = "A"
If num1 >= LBound(MyArray) And num1 <= UBound(MyArray) Then
test1 = MyArray(num1)
Else
test1 = "Item not here"
End If
End Function
Sub test()
Dim varTest As String
'Return the second item in the array from the function.
varTest = test1(1)
MsgBox varTest
'Return the first item in the array from the function.
varTest = test1(0)
MsgBox varTest
'Returns "subscript out of range" error as array is only 2 elements in size (0 and 1).
'The error is dealt with in the function using the IF....ELSE...END IF block and returns
'"Item not here" instead.
varTest = test1(2)
MsgBox varTest
End Sub
I solved this by using declaring the variables even when option explicit is not used.
The old code runs without throwing errors even when the variable is not declared and option explicit is also not used. But, for some reasons, it doesn't read / write undeclared variables as expected.
Now as per #cyril suggestion, I declared the variables being used and run the code. This time code ran as expected.
This happened for multiple of variables and at different stages in the code.
I have different Collections in my code. Some hold Objects (of various kinds), others have types (like Long) within them.
Is there a way to check if a key is contained in the Collection that works for types as well as objects?
So far I have two functions.
First function:
Private Function ContainsObject(objCollection As Object, strName As String) As Boolean
Dim o As Object
On Error Resume Next
Set o = objCollection(strName)
ContainsObject = (Err.Number = 0)
Err.Clear
End Function
Second function:
Private Function ContainsLong(AllItems As Collection, TheKey As String) As Boolean
Dim TheValue As Long
On Error Resume Next
TheValue = AllItems.Item(TheKey)
ContainsLong = (Err.Number = 0)
Err.Clear
End Function
The reason for the two functions is that ContainsObject does not seem to work if I pass a Collection that has Longs pairs (the function always returns False.)
P.S.: The first function is a copy of the third answer from Test or check if sheet exists
You should use a Variant in the first function. You can assign an Object to a Variant, e.g. this won't error:
Sub Test()
Dim var As Variant
Dim obj As Object
Set obj = Application
var = Application
Debug.Print var
End Sub
But this will give a Type Mismatch compile error i.e. trying to assign a Long to an Object:
Sub Test()
Dim obj As Object
Dim lng As Long
lng = 3
Set obj = lng
End Sub
So, for a generic function (along the lines of your code) to check if a Collection key is valid, you can use:
Function HasKey(coll As Collection, strKey As String) As Boolean
Dim var As Variant
On Error Resume Next
var = coll(strKey)
HasKey = (Err.Number = 0)
Err.Clear
End Function
Test code:
Sub Test()
Dim coll1 As New Collection
coll1.Add Item:=Sheet1.Range("A1"), Key:="1"
coll1.Add Item:=Sheet1.Range("A2"), Key:="2"
Debug.Print HasKey(coll1, "1")
Dim coll2 As New Collection
coll2.Add Item:=1, Key:="1"
coll2.Add Item:=2, Key:="2"
Debug.Print HasKey(coll2, "1")
End Sub
There is a useful article on MSDN regarding this. The context is VB6 but relates to VBA.
Few typos as per comments have already been corrected during edit of your post.
In response to your question I would like to cover related aspects.
While Using keys in collections has mainly three advantages
- If the order changes your code will still access the correct item
- You can directly access the item without reading through the entire
collection
- It can make you code more readable.
*But at the same time there are mainly three issues with using keys in
collections
You cannot check if the key exists
You cannot change the key
You cannot retrieve the key
As per Pearsons article the Keys of a Collection are write-only -- there is no way to get a list of existing Keys of a Collection. Further going through quoted paragraph:-
Here, Coll is a Collection object in which we will store multiple
CFile objects. The CollKeys Collection is used to store the keys of
the CFile objects stored in the Coll Collection. We need this second
Collection because the Keys of a Collection are write-only -- there is
no way to get a list of existing Keys of a Collection. One of the
enhancements provided by CFiles is the ability to retrieve a list of
Keys for the Collection.
Custom Collection Classes
One way is to iterate over the members of the collection and see if there is match for what you are looking for and the other way is to catch the Item not in collection error and then set a flag to say the item does not exist. Opinions differ on these approaches whereas some people feel it is not a good method to catch error while other section feels that it will be significantly faster than iteration for any medium to large collection.
So if we go for a method to catch error then error number we get depends on exactly what caused the error. We need a code routine to check the error. In a simplest way it could be.
'c1 is the collection
For i = 1 To c1.Count
Debug.Print Err.Number, Err.Description
If Err.Number <> 0 Then Err.Clear
Next i
Error catching routines proposed by various professionals differ in the error number they consider important and include in their routine.Various commonly occurring error numbers associated with collection object are:-
Error 5 Invalid procedure call or argument.This error can also occur
if an attempt is made to call a procedure that isn't valid on the
current platform. For example, some procedures may only be valid for
Microsoft Windows, or for the Macintosh, and so on.
error 438 "object doesn't support this property or method An object
is a class instance. A class instance supports some properties
defined in that class type definition and does not support this one.
Error 457 This key is already associated with an element of this
collection.You specified a key for a collection member that already
identifies another member of the collection. Choose a different key
for this member.
Error 91 Object variable or With block variable not set.There are two
steps to creating an object variable. First you must declare the
object variable. Then you must assign a valid reference to the object
variable using the Set statement. You attempted to use an object
variable that isn't yet referencing a valid object.
Error 450 Wrong number of arguments or invalid property
assignment.The number of arguments in the call to the procedure
wasn't the same as the number of required arguments expected by the
procedure.If you tried to assign a value to a read-only property,
Among the above errors error number 438 has been considered important and the other one is 5. I am incorporating a Function routine in my sample testing program which was posted by Mark Nold 7 years back in 2008 vide SO question Determining whether an object is a member of a collection in VBA with due credit to him.
Some errors like error 457 won't be allowed at the time of program test run. I tried to populated with duplicate keys data, it gave the error at the time of program testing itself as shown in the snapshot.
After removing it is showing correct output as shown in the snap shot.
It may not be possible to get the list of keys of a collection with a vanilla collection without storing the key values in an independent array. The easiest alternative to do this is to add a reference to the Microsoft Scripting Runtime & use a more capable Dictionary instead.
I have included this approach to get the list of keys in my program.
While populating Collection it is to be ensured that the key is the second parameter and must be a unique string.
Full code of my program is.
Sub Generic_key_check()
Dim arr As Variant
Dim c1 As New Collection
Dim dic As Object
With Application
.ScreenUpdating = False
End With
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
'Populate the collection
c1.Add "sheet1", "sheet1"
c1.Add "sheet2", "sheet2"
c1.Add "sheet3", "sheet3"
c1.Add "sheet4", "sheet4"
c1.Add "sheet5", "sheet5"
c1.Add 2014001, "Long1"
c1.Add 2015001, "Long2"
c1.Add 2016001, "Long3"
c1.Add 2015002, "Long4"
c1.Add 2016002, "Long5"
'Populate the dictionary
dic.Add "sheet1", "sheet1"
dic.Add "sheet2", "sheet2"
dic.Add "sheet3", "sheet3"
dic.Add "sheet4", "sheet4"
dic.Add "sheet5", "sheet5"
dic.Add "Long1", 2014001
dic.Add "Long2", 2015001
dic.Add "Long3", 2016001
dic.Add "Long4", 2015002
dic.Add "Long5", 2016002
' Get a list of key items by Dictionary Method
Dim N As Variant
For Each N In dic.Keys
Debug.Print "Key: " & N, "Value: " & dic.item(N)
Next
'Test for two types of data whether key exists or not.
If InCollection(c1, "Long1") Then
'If Exists("Long1", c1) Then
Debug.Print "Good"
Else
' If there is error then print out the error number and its description.
Debug.Print Err.Number, Err.Description
Debug.Print "Not Good"
End If
If InCollection(c1, "sheet2") Then
Debug.Print "Good"
Else
Debug.Print Err.Number, Err.Description
Debug.Print "Not Good"
End If
'Checking whether desired key has populated correctly
Debug.Print c1("Sheet1")
Debug.Print c1("Long3")
'Listing out collection items to check theyexist in the collection.
For i = 1 To c1.Count
Debug.Print c1.item(i)
Next i
With Application
.ScreenUpdating = True
End With
Set c1 = Nothing
End Sub
Public Function InCollection(col As Collection, key As String) As Boolean
Dim var As Variant
Dim errNumber As Long
InCollection = False
Set var = Nothing
Err.Clear
On Error Resume Next
var = col.item(key)
errNumber = CLng(Err.Number)
On Error GoTo 0
'5 is not in, 0 and 438 represent incollection
If errNumber = 5 Then ' it is 5 if not in collection
InCollection = False
Else
InCollection = True
End If
End Function
Final output as per program as shown in the Immediate window has been shown in the Snapshot.
Apostle is almost correct with their answer. Robin's answer will not work with generic objects, but will work as written because Excel's Range object will return the cell's value. I love Apostle's use of IsObject (mostly because ths is what I had figured out as well). The code is a little over-complicated though.
If the key exists in the collection IsObject will set the variant to True or False, otherwise an error will be ignored leaving the variant empty.
Function HasKey(col As Collection, Key As String) As Boolean
Dim v As Variant
On Error Resume Next
v = IsObject(col.Item(Key))
HasKey = Not IsEmpty(v)
End Function
I want to point out that if you want to make PaulE's function a little more flexible, you can change the string parameter to a Variant, which means that you can now also use it to check either for an item key or for an item number, which is handy. Variants are a little slower if you're going to be checking a lot of collections, but for most purposes the two functions will act similarly.
Function HasItem(col As Collection, ItemKeyOrNum As Variant) As Boolean
Dim v As Variant
On Error Resume Next
v = IsObject(col.Item(ItemKeyOrNum))
HasItem = Not IsEmpty(v)
End Function
The accepted answer here is wrong (which is the case for quite a few other questions I have noticed as well, so watch out, and read all the answers). Apostle and PaulE collaborated there for the most correct answer to the specific question that was asked. I tried to use the accepted answer, but it didn't work.
The question clearly states, "Is there a way to check if a key is contained in the Collection that works for types as well as objects?"
The accepted answer DOES NOT work for objects. PaulE's answer is the final, and correct answer. I am just adding a little bit of nuance here to make the function more one-size-fits-all.
Short variant in one string:
Function keyExists(coll As Collection, key As String) As Boolean
On Error Resume Next: keyExists = IsObject(coll(key)) Or True
End Function
First, keyExists = false. Error trapper set to ignore errors. If expression (always TRUE) was calculated without errors (element with key exists), keyExists was TRUE.
Usage (with various types of values in collection):
Sub testExist()
Dim coll As New Collection
coll.Add New Collection, "1"
coll.Add Array(1, 1), "3"
coll.Add 1, "5"
coll.Add "1111", "9"
For i = 1 To 10
Debug.Print "key " & i & " is " & IIf(keyExists(coll, CStr(i)), "Exists", "Absent")
Next
End Sub
The method from Robin will fail if the Collection contains objects rather than primitive types because they need to be assigned using Set and otherwise generate an error that will result in the method returning False. Here is a small adjustment:
'Test if a key is available in a collection
Public Function HasKey(coll As Collection, strKey As String) As Boolean
On Error GoTo IsMissingError
Dim val As Variant
' val = coll(strKey)
HasKey = IsObject(coll(strKey))
HasKey = True
On Error GoTo 0
Exit Function
IsMissingError:
HasKey = False
On Error GoTo 0
End Function