BkPlanner
02-09-2007, 09:21 AM
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):
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
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):
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