Runtime Error '457' help

[Elliottj2121]

Hello,

I do not know what happened to my code or what I did differently. My code worked perfectly yesterday and something changed and I was hoping someone here could help. I am getting a "This key is already associated with an element of this collection" message. I have the section of code below and example data. Any help would be greatly appreciated!!

Sub MasterARdue45O()
  Dim wbARDue45 As Workbook, wbWorkingARDue45 As Workbook
  Set wbARDue45 = OpenWkbARDue45
  Set wbWorkingARDue45 = OpenWkbWorkingARDue45
  Ardue45formatting wbARDue45
  MergeData wbARDue45, wbWorkingARDue45
  WorkingArdue45formatting wbWorkingARDue45
End Sub

Function OpenWkbWorkingARDue45() As Workbook
  Dim sPath As String, sName As String
  sName = "Working45.xlsx"
  sPath = Environ("USERPROFILE") & "\Desktop\" & sName
  Set OpenWkbWorkingARDue45 = Workbooks.Open(Filename:=sPath)
End Function
Function OpenWkbARDue45() As Workbook
  Dim sPath As String, sName As String
  sName = "ARdue45.xlsx"
  sPath = Environ("USERPROFILE") & "\Desktop\" & sName
  Set OpenWkbARDue45 = Workbooks.Open(Filename:=sPath)
End Function

Sub MergeData(wkbFrom As Workbook, wkbTo As Workbook)
  Dim wsFrom As Worksheet, wsTo As Worksheet, CrntIDs As Scripting.Dictionary
  Dim lFromRow As Variant, lToRow As Variant, r As Long, i As Long
  Set wsFrom = wkbFrom.Worksheets(1)
  Set wsTo = wkbTo.Worksheets(1)
  lToRow = LastRow(wsTo)
  If lToRow > 0 Then
    Set CrntIDs = New Dictionary
    For r = 2 To lToRow
      CrntIDs.Add CStr(wsTo.Cells(r, 3).Value), r
    Next r
  End If
  lFromRow = LastRow(wsFrom)
  If lFromRow > 0 Then
    For r = 2 To lFromRow
      If CrntIDs.Exists(CStr(wsFrom.Cells(r, 3).Value)) Then
        i = CrntIDs(CStr(wsFrom.Cells(r, 3).Value))
        wsFrom.Range("A" & r & ":D" & r).Copy wsTo.Cells(i, 1)
        wsFrom.Range("F" & r & ":I" & r).Copy wsTo.Cells(i, 6)
      Else
        wsFrom.Range("A" & r & ":I" & r).Copy wsTo.Cells(lToRow + 1, 1)
        lToRow = lToRow + 1
      End If
    Next r
  End If
End Sub
Function LastRow(sh As Worksheet) As Variant
  On Error Resume Next
  LastRow = sh.Cells.Find(what:="*", _
                          After:=sh.Range("A1"), _
                          lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
  On Error GoTo 0
End Function

This is the wsFrom worksheet

Status	Out Salesman #	Customer Number	COMPANY	COMMENTS	45 Days	Due 60	BALANCE	Credit Manager
	0182	0110756	APPPLE	A	585360.11	287986.53	2855728.70	Ed
	0182	0111984	APPPLE	A	133513.06	0.00	259423.40	Ed
	0182	0112105	BANANA	A	4207.80	0.00	28635.12	Ed
	0430	0400616	CARROT	A	248383.78	1198045.85	2221126.87	Mike
	0225	0203839	DOG	A	94276.00	0.00	343407.39	Katie
	0481	0400213	ELEPHANT	I	18762.82	-353.57	64820.39	Hope
	0481	0400570	FLAMINGO	A	152.27	0.00	15017.72	Hope
	0430	0400470	GATOR	A	1830853.43	72479.54	7102673.30	Katie
	0135	0110221	HIPPO	A	3435.68	0.00	140687.56	Ed
	0135	0111320	JERRY	A	9622.11	0.00	51350.22	Ed
	0220	0202194	KITE	A	263.94	-161.73	582.44	Katie
	0150	0110901	LLAMA	A	162459.39	0.00	556032.63	Ed

This is the wbTo worksheet:

Status	Sales	Number	NAME	Notes	45 Days	Due 60	BALANCE	Credit
	0182	0110756	APPPLE	ACH 5-19	674986.0454	149428.8094	2801244.605	Ed
	0182	0111984	APPPLE	ACH 5-19	133513.0606	0	259423.3995	Ed
Call	0182	0112105	BANANA	EM 5-15	1039.68541	0	26581.20974	Ed
	0430	0400616	CARROT	ACH 5-19	248383.7848	1198045.851	2158360.728	Mike
Call	0225	0203839	DOG	EM 5-15	43410.01275	0	343407.3884	Katie
Call	0481	0400213	ELEPHANT	EM 5-15	18762.82481	-353.5730964	64820.38747	Hope
Call	0481	0400570	FLAMINGO	A	152.2721972	0	13859.149	Hope
	0430	0400470	GATOR	ACH 5-22	1845814.736	57518.23259	6979415.053	Katie
Fax	0135	0110221	HIPPO	Fax 5-16	3435.684719	0	140687.5646	Ed
Fax	0145	0101175	JERRY	Fax 5-16	116474.9006	16994.75792	346526.7216	Ed

 

[RoryA]

You must have duplicated values in column C.

 

[AOB]

Well the message "This key is already associated with an element of this collection" implies an issue with your dictionary CrntIDs.

Specifically, that you are trying to add a key/value pair to that dictionary, where the key already exists (dictionary keys are indexed and must be unique)

So, I would debug the code and check what is being added to the dictionary at this line :

For r = 2 To lToRow
    CrntIDs.Add CStr(wsTo.Cells(r, 3).Value), r
Next r

...while watching the existing keys in a watch window and confirming that each key does not already exist before you add it?

May be no harm to test for the existence of a key before adding the key/value pair as VBA won't check this for you automatically :

For r = 2 To lToRow
    If Not CrntIDs.Exists(CStr(wsTo.Cells(r, 3).Value)) Then
        CrntIDs.Add CStr(wsTo.Cells(r, 3).Value), r
    End If
Next r

Unless of course you're expecting the same key to appear multiple times, in which case you need to reevaluate what you're using as a key for the dictionary in the first place...

 

[Elliottj2121]

Well the message "This key is already associated with an element of this collection" implies an issue with your dictionary CrntIDs.

Specifically, that you are trying to add a key/value pair to that dictionary, where the key already exists (dictionary keys are indexed and must be unique)

So, I would debug the code and check what is being added to the dictionary at this line :

For r = 2 To lToRow
    CrntIDs.Add CStr(wsTo.Cells(r, 3).Value), r
Next r

...while watching the existing keys in a watch window and confirming that each key does not already exist before you add it?

May be no harm to test for the existence of a key before adding the key/value pair as VBA won't check this for you automatically :

For r = 2 To lToRow
    If Not CrntIDs.Exists(CStr(wsTo.Cells(r, 3).Value)) Then
        CrntIDs.Add CStr(wsTo.Cells(r, 3).Value), r
    End If
Next r

Unless of course you're expecting the same key to appear multiple times, in which case you need to reevaluate what you're using as a key for the dictionary in the first place...

How to watch the existing keys in a watch window at that line?

 

[AOB]

How to watch the existing keys in a watch window at that line?

1. Add a breakpoint at that line (right-click > Toggle > Breakpoint, or just click in the narrow margin to the left of the code window)
2. Right-click on CrntIDs in the code and Add Watch...
3. When the Add Watch dialog appears, modify the expression from CrntIDs to CrntIDs.Keys (or add a separate watch so you can see both the keys and values at the same time)
4. Use F8 to step through the code line by line and monitor the dictionaries as you go

 

[Elliottj2121]

1. Add a breakpoint at that line (right-click > Toggle > Breakpoint, or just click in the narrow margin to the left of the code window)
2. Right-click on CrntIDs in the code and Add Watch...
3. When the Add Watch dialog appears, modify the expression from CrntIDs to CrntIDs.Keys (or add a separate watch so you can see both the keys and values at the same time)
4. Use F8 to step through the code line by line and monitor the dictionaries as you go

Thank you for this! Sorry I am late on my response. What happened is in the column with the customer numbers there was a space in a cell a few rows below the data.