How do I determine whether an object is a member of a collection in VBA?
Specifically, I need to find out whether a table definition is a member of the TableDe
i used this code to convert array to collection and back to array to remove duplicates, assembled from various posts here (sorry for not giving properly credit).
Function ArrayRemoveDups(MyArray As Variant) As Variant
Dim nFirst As Long, nLast As Long, i As Long
Dim item As Variant, outputArray() As Variant
Dim Coll As New Collection
'Get First and Last Array Positions
nFirst = LBound(MyArray)
nLast = UBound(MyArray)
ReDim arrTemp(nFirst To nLast)
i = nFirst
'convert to collection
For Each item In MyArray
skipitem = False
For Each key In Coll
If key = item Then skipitem = True
Next
If skipitem = False Then Coll.Add (item)
Next item
'convert back to array
ReDim outputArray(0 To Coll.Count - 1)
For i = 1 To Coll.Count
outputArray(i - 1) = Coll.item(i)
Next
ArrayRemoveDups = outputArray
End Function
I wrote this code. I guess it can help someone...
Public Function VerifyCollection()
For i = 1 To 10 Step 1
MyKey = "A"
On Error GoTo KillError:
Dispersao.Add 1, MyKey
GoTo KeepInForLoop
KillError: 'If My collection already has the key A Then...
count = Dispersao(MyKey)
Dispersao.Remove (MyKey)
Dispersao.Add count + 1, MyKey 'Increase the amount in relationship with my Key
count = Dispersao(MyKey) 'count = new amount
On Error GoTo -1
KeepInForLoop:
Next
End Function
It requires some additional adjustments in case the items in the collection are not Objects, but Arrays. Other than that it worked fine for me.
Public Function CheckExists(vntIndexKey As Variant) As Boolean
On Error Resume Next
Dim cObj As Object
' just get the object
Set cObj = mCol(vntIndexKey)
' here's the key! Trap the Error Code
' when the error code is 5 then the Object is Not Exists
CheckExists = (Err <> 5)
' just to clear the error
If Err <> 0 Then Call Err.Clear
Set cObj = Nothing
End Function
Source: http://coderstalk.blogspot.com/2007/09/visual-basic-programming-how-to-check.html
Not exactly elegant, but the best (and quickest) solution i could find was using OnError. This will be significantly faster than iteration for any medium to large collection.
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
You can shorten the suggested code for this as well as generalize for unexpected errors. Here you go:
Public Function InCollection(col As Collection, key As String) As Boolean
On Error GoTo incol
col.Item key
incol:
InCollection = (Err.Number = 0)
End Function
this version works for primitive types and for classes (short test-method included)
' TODO: change this to the name of your module
Private Const sMODULE As String = "MVbaUtils"
Public Function ExistsInCollection(oCollection As Collection, sKey As String) As Boolean
Const scSOURCE As String = "ExistsInCollection"
Dim lErrNumber As Long
Dim sErrDescription As String
lErrNumber = 0
sErrDescription = "unknown error occurred"
Err.Clear
On Error Resume Next
' note: just access the item - no need to assign it to a dummy value
' and this would not be so easy, because we would need different
' code depending on the type of object
' e.g.
' Dim vItem as Variant
' If VarType(oCollection.Item(sKey)) = vbObject Then
' Set vItem = oCollection.Item(sKey)
' Else
' vItem = oCollection.Item(sKey)
' End If
oCollection.Item sKey
lErrNumber = CLng(Err.Number)
sErrDescription = Err.Description
On Error GoTo 0
If lErrNumber = 5 Then ' 5 = not in collection
ExistsInCollection = False
ElseIf (lErrNumber = 0) Then
ExistsInCollection = True
Else
' Re-raise error
Err.Raise lErrNumber, mscMODULE & ":" & scSOURCE, sErrDescription
End If
End Function
Private Sub Test_ExistsInCollection()
Dim asTest As New Collection
Debug.Assert Not ExistsInCollection(asTest, "")
Debug.Assert Not ExistsInCollection(asTest, "xx")
asTest.Add "item1", "key1"
asTest.Add "item2", "key2"
asTest.Add New Collection, "key3"
asTest.Add Nothing, "key4"
Debug.Assert ExistsInCollection(asTest, "key1")
Debug.Assert ExistsInCollection(asTest, "key2")
Debug.Assert ExistsInCollection(asTest, "key3")
Debug.Assert ExistsInCollection(asTest, "key4")
Debug.Assert Not ExistsInCollection(asTest, "abcx")
Debug.Print "ExistsInCollection is okay"
End Sub