PDA

View Full Version : [SOLVED] Test if an item exists within a collection data type



Digita
04-20-2009, 12:11 AM
Guys,

I'm doing a little test using the item method. My sample data in column A contains a lot of repeating values. My code below loads unique values to a collection. This part is working OK. My code errors out with a message "Run-time Error '424' Object required". What am I missing?


Dim cUnique As Collection
Dim Rng As Range
Dim Cel As Range
Dim sh As Worksheet
Dim N As Variant, fvalue
Set sh = ThisWorkbook.Sheets("Sheet1")
Set Rng = sh.Range("A1", sh.Range("A1").End(xlDown))
Set cUnique = New Collection
On Error Resume Next
For Each Cel In Rng.Cells
cUnique.Add Cel.Value, CStr(Cel.Value)
Next Cel
On Error GoTo 0
fvalue = cUnique.Item("Lemon")
If Error.Number = 0 Then
msgbox "found"
Else
msgbox "not found"
End If



Thanks & regards


kp

Bob Phillips
04-20-2009, 12:55 AM
Sub Test()
Dim cUnique As Collection
Dim Rng As Range
Dim Cel As Range
Dim sh As Worksheet
Dim N As Variant, fvalue
Set sh = ThisWorkbook.Sheets("Sheet1")
Set Rng = sh.Range("A1", sh.Range("A1").End(xlDown))
Set cUnique = New Collection
On Error Resume Next
For Each Cel In Rng.Cells
cUnique.Add Cel.Value, CStr(Cel.Value)
Next Cel
On Error GoTo 0
If ExistsInCollection(cUnique, "Lemon") Then
MsgBox "found"
Else
MsgBox "not found"
End If
End Sub

Public Function ExistsInCollection(pColl, ByVal pKey As String) As Boolean
On Error GoTo NoSuchKey
If VarType(pColl.Item(pKey)) = vbObject Then
' force an error condition if key does not exist
End If
ExistsInCollection = True
Exit Function
NoSuchKey:
ExistsInCollection = False
End Function

georgiboy
04-20-2009, 01:06 AM
Dim cUnique As Collection
Dim Rng As Range
Dim Cel As Range
Dim sh As Worksheet
Dim N As Variant, fvalue
Set sh = ThisWorkbook.Sheets("Sheet1")
Set Rng = sh.Range("A1", sh.Range("A1").End(xlDown))
Set cUnique = New Collection
On Error Resume Next
For Each Cel In Rng.Cells
cUnique.Add Cel.Value, CStr(Cel.Value)
Next Cel
On Error GoTo jump
fvalue = cUnique.Item("Lemon")
MsgBox "found"
Exit Sub
jump:
MsgBox "not found"

Digita
04-20-2009, 03:49 PM
Brilliant. Both solutions work beautifully.

Thanks Bob & Georgiboy.


kp