PDA

View Full Version : Error When Testing Collection for Key Exists



SamT
02-10-2016, 06:39 PM
What am I doing wrong. UEs I tried them in the original forms and they failed too. The only changes I made in the to P codes is moving the Collection to Module Level

Option Explicit

Dim col As New Collection

Sub Test()
Dim X
col.Add "A", "B"
'X = ItemExists("t")
'X = InCollection("T")
X = ExistsInCollection("T")
End Sub


Function ItemExists(Kee) As Boolean
Dim X
Err = 0
On Error GoTo NoExist
X = col(Kee) 'Fails
ItemExists = True
NoExist:
End Function


Public Function InCollection(Kee As String) As Boolean
'http://www.freevbcode.com/ShowCode.asp?ID=4518
Dim bTest As Boolean

On Error Resume Next

bTest = IsObject(col(Kee)) 'Fails
If (Err = 0) Then
InCollection = True
Else
Err.Clear
End If

End Function


Public Function ExistsInCollection(Kee As String) As Boolean
'xld
'http://www.vbaexpress.com/forum/showthread.php?26312

'Added
Dim X
X = VarType(col) 'Works
'End Added

On Error GoTo NoSuchKey
If VarType(col.Item(Kee)) = vbObject Then 'Fails
' force an error condition if key does not exist
End If
ExistsInCollection = True
Exit Function

NoSuchKey:
ExistsInCollection = False
End Function

pike
02-10-2016, 11:24 PM
Hi Sam,
possibly

Public Function InCollection(objCollection As Collection, strKey As String) As Boolean
Dim varError As Variant
Dim lngError As Long
InCollection = False
Set varError = Nothing
Err.Clear
On Error Resume Next
varError = objCollection.Item(strKey)
lngError = CLng(Err.Number)
On Error GoTo 0
'5 is not in, 0 and 457 represent in objCollection and maybe 438?
If lngError = 5 Then ' it is 5 if not in objCollection
InCollection = False
Else
InCollection = True
End If
End Function

snb
02-11-2016, 12:35 AM
That 's a lot of code....


Dim col As New Collection

Sub Test()
col.Add "A", "B"
MsgBox F_ExistsInCollection("T")
col.Add "A", "T"
MsgBox F_ExistsInCollection("T")
End Sub

Function F_ExistsInCollection(Kee As String) As Boolean
On Error resume next
c00=col(Kee)
F_ExistsInCollection = err.number=0
End Function

SamT
02-11-2016, 12:53 AM
Pike,
Yes I tried that one too, even though the posts after the method noted that any unexpected err # other than 5 would return True

Snb,
I will try that one too, But I expect the same issue.

All the subs halt at the Error and present the Error message. They all fail to On Error GoTo Label or On Error Resume next

I will work on it some more tomorrow.

GTO
02-11-2016, 01:23 AM
What am I doing wrong. UEs I tried them in the original forms and they failed too. The only changes I made in the to P codes is moving the Collection to Module Level

Hi Sam,

I didn't understand the acronyms, ...


All the subs halt at the Error and present the Error message. They all fail to On Error GoTo Label or On Error Resume next

... but I think I got this part. I tested thusly:



Option Explicit
'
Dim COL As New Collection
'
Sub Test()
Dim X
COL.Add "A", "B"
'
'
MsgBox ItemExists("t")
MsgBox ItemExists("b")
'
MsgBox InCollection("T")
MsgBox InCollection("b")
'
MsgBox ExistsInCollection("T")
MsgBox ExistsInCollection("B")
'
Set COL = Nothing
'
End Sub
'
Function ItemExists(Kee) As Boolean
Dim X
Err = 0
On Error GoTo NoExist
X = COL(Kee) 'Fails
ItemExists = True
NoExist:
End Function
'
Public Function InCollection(Kee As String) As Boolean
'http://www.freevbcode.com/ShowCode.asp?ID=4518
Dim bTest As Boolean
'
On Error Resume Next
'
bTest = IsObject(COL(Kee)) 'Fails
If (Err = 0) Then
InCollection = True
Else
Err.Clear
End If
'
End Function
'
Public Function ExistsInCollection(Kee As String) As Boolean
'xld
'http://www.vbaexpress.com/forum/showthread.php?26312
'
'Added
Dim X
X = VarType(COL) 'Works
'End Added
'
On Error GoTo NoSuchKey
If VarType(COL.Item(Kee)) = vbObject Then 'Fails
' force an error condition if key does not exist
End If
ExistsInCollection = True
Exit Function
'
NoSuchKey:
ExistsInCollection = False
End Function


And I got the expected returns; False, True, False, True, False, True

Might it be something as simple as your Options somehow got reset to 'Break on all Errors' ?

Mark

Paul_Hossler
02-11-2016, 03:00 PM
slight re-arranging, but this all works as expected




Option Explicit

Dim col As Collection

Sub Test()
Dim X1 As Boolean, X2 As Boolean, X3 As Boolean

Set col = New Collection

col.Add "ITEM1", "KEY1"
col.Add "ITEM2", "KEY2"

X1 = ItemExists("xxx")
X2 = InCollection("xxx")
X3 = ExistsInCollection("xxx")

MsgBox X1
MsgBox X2
MsgBox X3


X1 = ItemExists("key1")
X2 = InCollection("key2")
X3 = ExistsInCollection("KEY1")

MsgBox X1
MsgBox X2
MsgBox X3

End Sub

Function ItemExists(Kee As String) As Boolean
Dim X As Variant

Err = 0
On Error GoTo NoExist
X = col(Kee) 'Fails
ItemExists = True
NoExist:
End Function

Public Function InCollection(Kee As String) As Boolean
'http://www.freevbcode.com/ShowCode.asp?ID=4518
Dim bTest As Boolean

On Error Resume Next

bTest = IsObject(col(Kee)) 'Fails
If (Err = 0) Then
InCollection = True
Else
Err.Clear
End If

End Function

Public Function ExistsInCollection(Kee As String) As Boolean
'xld
'http://www.vbaexpress.com/forum/showthread.php?26312

'Added
Dim X
X = VarType(col) 'Works
'End Added

On Error GoTo NoSuchKey
If VarType(col.Item(Kee)) = vbObject Then 'Fails
' force an error condition if key does not exist
End If
ExistsInCollection = True
Exit Function

NoSuchKey:
ExistsInCollection = False
End Function

SamT
02-11-2016, 04:53 PM
A big, big THANK YOU to all that helped :bow:



I got tired of working on the problem and took a nap.:snooze

I awoke with the answer . :biggrin:

Went to the Options Menu, General Tab, and took it off "Break on All Errors" :D

SamT
02-11-2016, 04:59 PM
:wine: for GTO