VBA: "Run-time error '457':This key is already associated with an element of this collection"

Question

I am having trouble writing a macro for comparing multiple columns in multiple sheets (of same excel file). I wrote few but they were taking so long that excel was crashing.

Let's say I have 4 sheets in one same file. Sheet1 with two columns (B and C) and 7000 rows. Sheet2 empty sheet new entries. Sheet3 empty sheet for old entries but with some updated value/info. Sheet4 is a database with 2 columns (A and B) and 22000 rows.

I need to compare Column A from Sheet1 to Column B in Sheet4. If there are completely new entries in Column A sheet1, then copy that entry from Column A sheet1 (and its respective value from Column B sheet1) to a new row (columns A and B) in Sheet2. If there are entries in Column A Sheet1 that are already in Column A sheet4, then compare their respective Column B values. If column A+column B combo from Sheet 1 is in Sheet4 then ignore it. If a Value from Column A Sheet1 is in Column A Sheet4, but their respective Column B values are not matching then copy Column A+Column B from Sheet1 to new row (columns A and B) in Sheet3.

I hope it is clear enough. Due to amount of rows (7000 in Sheet1 to be compared to 20000 in Sheet4) I cannot write a macro that processes everything under a minute.

Any help ?

Edit 1: I used the code suggested by @FaneDuru (Thank You!). but I am encountering an error: "Run-time error '457':This key is already associated with an element of this collection" Is it because I have many repeating values in same columns ?

Edit 2: It seems like "if not dict3.exists" code is not recognized by VBA. When I type ".exists" with smaller letter and jump to another line it is supposed correct it to capital ".Exists", right? It is not doing it.

Edit 3: I did some more testing. I was putting breaks and running the code. When I put the break on this line "If WorksheetFunction.CountIf(rngA4, arr1(i, 1)) > 0 Then", no error happens. When I put the break on one line below "For j = UBound(arr4) To 1 Step -1", the error is happening.

Error is : "Run-time error '457':This key is already associated with an element of this collection"

Private Sub CommandButton1_Click()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim arr1, arr2, arr3, arr4, dict2 As Object, dict3 As Object, rngA4 As Range
Dim rngB4 As Range, i As Long, j As Long, lastR1 As Long, lastR4 As Long

lastR1 = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
lastR4 = Sheet4.Range("A" & Sheet4.Rows.Count).End(xlUp).Row

Set rngA4 = Sheet4.Range("A2:A" & lastR4)
Set rngB4 = Sheet4.Range("B2:B" & lastR4)

arr1 = Sheet1.Range("B2:C" & lastR1).Value
arr4 = Sheet4.Range("A2:B" & lastR4).Value

Set dict2 = CreateObject("Scripting.Dictionary")
Set dict3 = CreateObject("Scripting.Dictionary")

For i = UBound(arr1) To 1 Step -1
    If WorksheetFunction.CountIf(rngB4, arr1(i, 1)) = 0 Then
        dict2.Add arr1(i, 1), arr1(i, 2):
    End If
    If WorksheetFunction.CountIf(rngA4, arr1(i, 1)) > 0 Then
        For j = UBound(arr4) To 1 Step -1
            If arr1(i, 1) = arr4(j, 1) Then
                If arr1(i, 2) <> arr4(j, 2) Then
                    If arr1(i, 2) <> arr4(j, 2) Then
                        dict3.Add arr1(i, 1), arr1(i, 2): Exit For
                End If
            End If
        Next j
    End If
Next i

If dict2.Count > 0 Then
    arr2 = Application.Transpose(Array(dict2.keys, dict2.Items))
    Sheet2.Range("A2").Resize(dict2.Count, 2).Value = arr2
End If

If dict3.Count > 0 Then
    arr3 = Application.Transpose(Array(dict3.keys, dict3.Items))
    Sheet3.Range("A2").Resize(dict3.Count, 2).Value = arr3
End If

MsgBox "Done!"

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

Please, edit your question and post what you tried on your own. Even if it does not run exactly as you need. Some pictures (if not editable) showing the existing situation, respectively, the result you need, will also help. — FaneDuru, Feb 06 '21 at 16:30
What "If there are completely new entries in Column A sheet1" does mean? — FaneDuru, Feb 06 '21 at 16:39
"completely new entries in Column A sheet1" - means an entry among those 7000 rows in Sheet 1 that is not among 20000 rows in sheet4. — Elmar, Feb 06 '21 at 16:47
So, "completely" does not have any meaning... Now, is it possible to exist more occurrences of the string from Sheet1 in Sheet4 B or A columns? And, for making the code faster, how the sheets in discussion are updated? I mean, all the time new rows are added, or the new entries can be done in any column row (B or A)? — FaneDuru, Feb 06 '21 at 17:04
You still did not answer the clarification questions, but complain about " encountering an error"... I clearly stated the assumption "are not more than one occurrence". This is not a way of helping us to help you. Putting `On Error Resume Next` is not a good way of solving an error problem. You must understand where the problem comes and solve it according to its roots. So, do you have more such occurrences? If yes, how do you like the code to proceed in such a case? Then, telling us that an error appears **without telling on which code line**, is again a bad practice. Please, clarify it — FaneDuru, Feb 08 '21 at 08:47
hi! I am by no means complaining.I don't know how to contact you here,so to let you know that I tested the code I added 2 comments to your original comment (with your code) and also edited my original post.I was hoping that you would see my comments/edits. I apologize if it looks like I complained,I am just trying to show the test result.Answer is yes,there are hundreds of repeating values in the Sheet1 (as input of 7000 rows comes from different people). In the Sheet 4 (the database with 22000 rows), there should be no repetitions. so the code needs to be able to ignore those repetitions. — Elmar, Feb 08 '21 at 11:55
It was not really complaining... But not answering the clarification questions and the error is obviously related to the answer you should supply, it sounds strange (at least). Then, telling (only) about the error "Run-time error '457', without mentioning the code line where it is raised, is not useful. From the code context, I suppose that it should be on the line `dict3.Add arr1(i, 1), arr1(i, 2)`, since in the big sheet there are no duplicates. If I am right, the code should be adapted to previously check if the specific key exists. I will do it, but only after you confirm my supposition. — FaneDuru, Feb 08 '21 at 14:22

score 0 · Answer 1 · answered Feb 06 '21 at 16:24

0

You can use the excel formula countif to find any entry of data that doesn't exist in your dataset.

Then you can copy the value with Sheets().Range().Value = Sheets().Range().Value in the sheet where you want your output. If the output range is already populated you can use Sheets().Range().End(xlDown).Address to find the address of the last row of your output dataset.

You iterate through every countif values that return a 0 to get all the missing data.

answered Feb 06 '21 at 16:24

user14518362

320
4
11

That I know. But i'd like to able to do that with VBA alone. – Elmar Feb 06 '21 at 16:44
Vba can access Excel functions, in fact it's usually faster to use Excel functions with VBA, because Excel can calculate on multiple threads whereas VBA is not able to (you can work around it but it's really complicated and it's not worth the effort) – user14518362 Feb 06 '21 at 17:08
1

He does not need (only) to know if a specific string exists in the other sheet. He needs to populate Sheet2 with the missing ones and Sheet3 in some conditions. – FaneDuru Feb 06 '21 at 17:49
Fair enough I should have added something about using either the search function or the filter function to find which lines were unique – user14518362 Feb 07 '21 at 01:56

FaneDuru · Answer 2 · 2021-02-08T14:35:50.367

0

Please, test the next code. You did not answer the clarification questions and the code assumes that there are not more than one occurrence and the processed sheets are loaded by adding rows. The code works independent of this aspect, but if the above assumption is correct, it will run faster:

Sub testProcessNewEntries()
 Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
 Dim arr1, arr2, arr3, arr4, dict2 As Object, dict3 As Object, rngA4 As Range
 Dim rngB4 As Range, i As Long, j As Long, lastR1 As Long, lastR4 As Long
 
 Set sh1 = Worksheets("Sheet1") 'use here your first sheet
 Set sh2 = Worksheets("Sheet2") 'use here your second sheet
 Set sh3 = Worksheets("Sheet3") 'use here your third sheet
 Set sh4 = Worksheets("Sheet4") 'use here your fourth sheet
 
 lastR1 = sh1.Range("A" & sh1.Rows.count).End(xlUp).row
 lastR4 = sh4.Range("A" & sh4.Rows.count).End(xlUp).row
  
 Set rngA4 = sh4.Range("A2:A" & lastR4)
 Set rngB4 = sh4.Range("B2:B" & lastR4)
 
 arr1 = sh1.Range("A2:B" & lastR1).Value
 arr4 = sh4.Range("A2:B" & lastR4).Value
 
 Set dict2 = CreateObject("Scripting.Dictionary")
 Set dict3 = CreateObject("Scripting.Dictionary")
 
 For i = UBound(arr1) To 1 Step -1
    If WorksheetFunction.CountIf(rngB4, arr1(i, 1)) = 0 Then
        dict2.Add arr1(i, 1), arr1(i, 2):
    End If
    If WorksheetFunction.CountIf(rngA4, arr1(i, 1)) > 0 Then
        For j = UBound(arr4) To 1 Step -1
            If arr1(i, 1) = arr4(j, 1) Then
                If arr1(i, 2) <> arr4(j, 2) Then
                    If Not dict3.Exists(arr1(i, 1)) Then
                        dict3.Add arr1(i, 1), arr1(i, 2): Exit For
                    End If
                End If
            End If
        Next j
    End If
 Next i
 
 If dict2.count > 0 Then
    arr2 = Application.Transpose(Array(dict2.Keys, dict2.Items))
    sh2.Range("A2").Resize(dict2.count, 2).Value = arr2
 End If
 If dict3.count > 0 Then
    arr3 = Application.Transpose(Array(dict3.Keys, dict3.Items))
    sh3.Range("A2").Resize(dict3.count, 2).Value = arr3
 End If
 MsgBox "Ready..."
End Sub

edited Feb 08 '21 at 14:35

answered Feb 06 '21 at 18:24

FaneDuru

38,298
4
19
27

@Elmar: Didn't you find some time to check the above code? It has been written in order to answer **your** question. If tested, didn't it do what you need? – FaneDuru Feb 07 '21 at 09:31
first of all, I would like to thank you for taking time and helping me. I have tested the code (and still testing). I am encountering an error "Run-time error '457':This key is already associated with an element of this collection". Is it because there are many repeating values in my columns? – Elmar Feb 08 '21 at 00:02
I added "On Error Resume Next" and it seems like it has solved the issue. Do you think it is a good way? Hopefully it was is not an important error that will create a mess in my data. Btw, it worked like a charm (if we ignore the error ) and super fast!!! – Elmar Feb 08 '21 at 00:18
@Elmar: Please, test the updated code and confirm that it works without raising any error. – FaneDuru Feb 08 '21 at 14:36
If I am not mistaken, the only change you did to the code is in the "deepest" loop, correct?... If Not dict3.Exists(arr1(i, 1)) Then dict3.Add arr1(i, 1), arr1(i, 2): Exit For ...I am testing it and error still remains. Two observations: 1. You are correct, the error is caused by something in the loop. 2. it seems like "if not dict3.exists" code is not recognized by VBA. When I type ".exists" with smaller letter and jump to another line it is supposed correct it to capital ".Exists", right? It is not doing it. – Elmar Feb 08 '21 at 15:53
@Elmar: I tried explaining that only mentioning that " error still remains" does not help, if you do not clearly state on which line the error is raised. Then, in case of late binding, when the variable is declared `As Object`, VBA does not know what property is `.Exists` and it does not capitalize it, except the cases you already used it in another part of the compiled code. Please, write exactly which is the error description. The code should not raise any error in case of dictionary key duplicate. This should be eliminated by that line `If Not dict3.Exists(arr1(i, 1)) Then`. – FaneDuru Feb 08 '21 at 18:46
İ did some more testing. I was putting breaks and running the code. When I put the break on this line "If WorksheetFunction.CountIf(rngA4, arr1(i, 1)) > 0 Then", no error happens. When I put the break on one line below "For j = UBound(arr4) To 1 Step -1", the error is happening. Error is : "Run-time error '457':This key is already associated with an element of this collection". – Elmar Feb 08 '21 at 21:27

VBA: "Run-time error '457':This key is already associated with an element of this collection"

2 Answers2