re: Cannot Add Uniqe Items to a collection

[BkPlanner]

I have been programming Excel VBA macros for a couple years now. I am self taught, and do not pretend to be an expert. However, i have used the 'On Error Resume Next' Statement to add unique elements to a collection many time before. However, in the following code i cannot avoid getting the "the key is already associated with an element of this collection".

is is possible that I at some point set some sort of global preference for VBA error handling, or is there error in my code ?

I have been extremely frustrated by this error since I have used simmilar code countless times before and cannot explain why this is not working. Any suggestions would be gladly entertained.

this is the code (its in a module):

[VBA] Public Sub Create_Groups()

Dim rCurrent As Range
Dim Group_Variable As String
Dim Group_Variable_Index As Long
Dim OBJECTID_Index As Long
Dim row As Long
Dim col As Long
Dim Unique_Values As New Collection

'determine the user selection from the userform
Group_Variable = Make_Groups.Auto_Group_Combo_Box.Text

'set the current Range
Set rCurrent = ThisWorkbook.Names("Group").RefersToRange

'set the column index for Group_Variable
col = 1
Do While col < 256
If rCurrent.Offset(-2, col).Value = Group_Variable Then
Group_Variable_Index = col
Exit Do
ElseIf col = 255 Then
MsgBox Source_Name & " Does not appear to contain complete block and lot information", vbOKOnly, "Data Validation Error"
Exit Sub
Else:
col = col + 1
End If
Loop

'set the column index for the 'ObjectID' Column
col = 1
Do While col < 256
If rCurrent.Offset(-1, col).Value = "OBJECTID" Then
OBJECTID_Index = col
Exit Do
ElseIf col = 255 Then
MsgBox Source_Name & " Does not appear to contain complete information", vbOKOnly, "Data Validation Error"
Exit Sub
Else:
col = col + 1
End If
Loop

'reset the variables
row = 0
col = 0

'move through the range and add only the uniqe items to a collection
On Error Resume Next
Do Until rCurrent.Offset(row, OBJECTID_Index).Value = ""
Unique_Values.Add rCurrent.Offset(row, Group_Variable_Index).Value, CStr(rCurrent.Offset(row, Group_Variable_Index).Value)
row = row + 1
On Error GoTo 0
Loop

End Sub[/VBA]

[Bob Phillips]

Surey, you are resetting the error handler in the loop.

This

[vba]

'move through the range and add only the uniqe items to a collection
On Error Resume Next
Do Until rCurrent.Offset(row, OBJECTID_Index).Value = ""
Unique_Values.Add rCurrent.Offset(row, Group_Variable_Index).Value, CStr(rCurrent.Offset(row, Group_Variable_Index).Value)
row = row + 1
On Error GoTo 0
Loop
[/vba]

should be

[vba]

'move through the range and add only the uniqe items to a collection
On Error Resume Next
Do Until rCurrent.Offset(row, OBJECTID_Index).Value = ""
Unique_Values.Add rCurrent.Offset(row, Group_Variable_Index).Value, CStr(rCurrent.Offset(row, Group_Variable_Index).Value)
row = row + 1
Loop
On Error GoTo 0
[/vba]

[BkPlanner]

Right. Thanks for THAT catch. i actually had been fooling around with the code before I pasted into the web forum. However, I still get the error even after i change that.

here is the new code, that still gets the error:

[VBA] Public Sub Create_Groups()
Dim rCurrent As Range
Dim Group_Variable As String
Dim Group_Variable_Index As Long
Dim OBJECTID_Index As Long
Dim row As Long
Dim col As Long
Dim Unique_Values As New Collection
'determine the user selection
Group_Variable = Make_Groups.Auto_Group_Combo_Box.Text
'set the current Range
Set rCurrent = ThisWorkbook.Names("Group").RefersToRange

'set the index for Group_Variable
col = 1
Do While col < 256
If rCurrent.Offset(-2, col).Value = Group_Variable Then
Group_Variable_Index = col
Exit Do
ElseIf col = 255 Then
MsgBox Source_Name & " Does not appear to contain complete block and lot information", vbOKOnly, "Data Validation Error"
Exit Sub
Else:
col = col + 1
End If
Loop
'set the index for the 'ObjectID' Column
col = 1
Do While col < 256
If rCurrent.Offset(-1, col).Value = "OBJECTID" Then
OBJECTID_Index = col
Exit Do
ElseIf col = 255 Then
MsgBox Source_Name & " Does not appear to contain complete information", vbOKOnly, "Data Validation Error"
Exit Sub
Else:
col = col + 1
End If
Loop
'reset the variables
row = 0
col = 0
On Error Resume Next
Do Until rCurrent.Offset(row, OBJECTID_Index).Value = ""
Unique_Values.Add rCurrent.Offset(row, Group_Variable_Index).Value, CStr(rCurrent.Offset(row, Group_Variable_Index).Value)
row = row + 1
Loop
On Error GoTo 0
Stop
End Sub[/VBA]

[Bob Phillips]

Post the workbook.

[mdmackillop]

Hi BkPlanner,
Welcome to VBAX.
When you post code, please select it and click to VBA button to format it as shown. To post a workbook, use Manage Attachments in the Go Advanced section
Regards
MD

[BkPlanner]

here is the workbook. It has lots of functions You can execute the problem code from the "Auto Groups" button on the "pluto data" worksheet. The idea is that the workbook would come up with values for "GROUP" based on whatever field the user selects, rather than having to specify groups manually (though they can do that too if they want to)

Thanks also for the pointers about converting the code when I post. I've never tried one of these formus before, but I apprecaite the willingness to help.

thanks!

BKP

[Bob Phillips]

It is working fine for me.

What group did you select and how does the error manifest?

[BkPlanner]

I selected the "Block" as the means of grouping the elements and it manifests by giving me the "key is already assocaited with an element of this collection"

I fear that I have a stray setting or preference somewhere that is causing it not to recognize when I suspend the error handling for the colleciton, but I can't even begin to figure out where that might be.

[BkPlanner]

i tried it on two other machines in the office, and it works just fine. What could it be about my machine that is causing this error ?

thanks!

[BkPlanner]

Ok... so i feel like a major amateur. I had it set to "BREAK ON ALL ERRORS" and not "BREAK ON UNHANDLED ERRORS". I appologize for my extreme idiocy, and thank you for helping me work through this.

[mdmackillop]

Ok... so i feel like a major amateur.

This is known as "learning by experience", and while it's sometimes frustrating, it's rarely forgotten!
Gald you got it sorted.