no duplication please

[Guest]

THanks for the help with the "List without Listbox" question sbmitted
yesterday.

Due to the simplified nature of the "list", if thought that a "Collection"
would be sufficient. The problem is that i can't seem to get the "No
duplication" aspect to function. Any idea as to what I am doing wrong (other
than coding this myself )

Private Sub CommandOK_Click()
Dim NoDupes_test As New Collection
Dim i As Integer
Dim sStr

On Error Resume Next
NoDupes_test.Add Item:=sStr.Value, key:=sStr.Value
On Error GoTo 0

Select Case True
Case CheckMachine.Value
Range("A1").Value = "Marketing"
If CheckMNew.Value = True Then
NoDupes_test.Add "ProductManager"
End If
If CheckMFFF.Value = True Then
NoDupes_test.Add "ProductManager"
NoDupes_test.Add "Director of Engineering"
End If
If CheckMWarranty.Value = True Then
NoDupes_test.Add "Director of Engineering"
NoDupes_test.Add "Director of Service"
NoDupes_test.Add "Quality Manager"
End If
If CheckMDisc.Value = True Then
NoDupes_test.Add "ProductManager"
End If
'some or cases here
End Select

If NoDupes_test.Count > 0 Then
For i = 1 To NoDupes_test.Count
sStr = sStr & NoDupes_test(i) & vbLf
Next i
End If
Range("A4").Value = sStr

End Sub

 

[Doug Glancy]

Each time you add an item to the collection you need to bracket it with the
two "On Error" statements and you need to specify a key. The error is
genererated when you try to add a duplicate key. Your On Error statements
tell Excel to ignore the error, the key is not added and you get your
intended result of no duplicates. So, something like this:

If CheckMNew.Value = True Then
On Error Resume Next
NoDupes_test.Add Item:="ProductManager", Key = "ProductManager"
On Error GoTo 0
End If

hth,

Doug

 

[Guest]

thanks

Each time you add an item to the collection you need to bracket it with the
two "On Error" statements and you need to specify a key. The error is
genererated when you try to add a duplicate key. Your On Error statements
tell Excel to ignore the error, the key is not added and you get your
intended result of no duplicates. So, something like this:

If CheckMNew.Value = True Then
On Error Resume Next
NoDupes_test.Add Item:="ProductManager", Key = "ProductManager"
On Error GoTo 0
End If

hth,

Doug