VBA Compare 2 lists, from 2 sheets, add missing data to 1 of the lists

[THEsewingmaster]

Hello,
I'm new here! I've been scouring the web for a vba that would work for my application and found one. I adapted it to the list configuration I needed, but am having 1 problem: IT IS SLOW (I mean slooowww)! At the moment, I'm only comparing about 60 or so data entries against a list of 10.

So here is the scenario:
Comparing 2 sheets

• R_STATUS_LIST
• DATA

Searching data

• starting in C2, then C column for R_STATUS_LIST
• starting in F5, then F column for DATA

Copying the data that is found in R_STATUS_LIST but not found in DATA, then pasting it into the next available row in the F column (within the table) of DATA.

Here is the VBA I'm using:

Sub CompareLists2()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    With Sheets("DATA")
        For Each Rng In .Range("F5", .Range("F" & .Rows.Count).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                RngList.Add Rng.Value, Nothing
            End If
        Next
    End With
    With Sheets("R_STATUS_LIST")
        For Each Rng In .Range("C2", .Range("C" & .Rows.Count).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                Sheets("DATA").Cells(Sheets("DATA").Rows.Count, "F").End(xlUp).Offset(1, 0) = Rng
            End If
    
        Next
    End With
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub

Any help in a better solution that accomplishes this, would be much appreciated!!

 

[kokano90]

Bất kỳ trợ giúp nào trong một giải pháp tốt hơn hoàn thành điều này, sẽ được đánh giá cao !!

Try it:

Sub ABC()
Dim Dic As Object, Arr(), i&, Res(), iRow&
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("DATA")
    Arr = .Range("F5", .Range("F" & .Rows.Count).End(xlUp)).Value
    For i = 1 To UBound(Arr, 1)
        If Dic.exists(Arr(i, 1)) = False Then
            Dic.Add (Arr(i, 1)), ""
        End If
    Next
End With
With Sheets("R_STATUS_LIST")
    Arr = .Range("C2", .Range("C" & .Rows.Count).End(xlUp))
    For i = 1 To UBound(Arr)
        If Dic.exists(Arr(i, 1)) = False Then
            k = k + 1
            ReDim Preserve Res(1 To k)
            Res(k) = Arr(i, 1)
        End If
    Next
End With
iRow = Sheets("DATA").Range("F" & Rows.Count).End(3).Row + 1
Sheets("DATA").Range("F" & iRow).Value = Application.WorksheetFunction.Transpose(Res)
End Sub

 

[THEsewingmaster]

It gives me a "mismatch" error on this line of code:

    Arr = .Range("C2", .Range("C" & .Rows.Count).End(xlUp))

 

[kokano90]

It gives me a "mismatch" error on this line of code:

Can you send me your demo file

 

[THEsewingmaster]

It gives me a "mismatch" error on this line of code:

The data is alphanumeric. Would that be the cause of the mismatch error?

 

[kokano90]

edit

Sub ABC()
Dim Dic As Object, Arr(), i&, Res(), iRow&
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("DATA")
    Arr = .Range("F5:F"& .Range("F" & .Rows.Count).End(xlUp).row).Value
    For i = 1 To UBound(Arr, 1)
        If Dic.exists(Arr(i, 1)) = False Then
            Dic.Add (Arr(i, 1)), ""
        End If
    Next
End With
With Sheets("R_STATUS_LIST")
    Arr = .Range("C2:C"&.Range("C" & .Rows.Count).End(xlUp).row).value
    For i = 1 To UBound(Arr)
        If Dic.exists(Arr(i, 1)) = False Then
            k = k + 1
            ReDim Preserve Res(1 To k)
            Res(k) = Arr(i, 1)
        End If
    Next
End With
iRow = Sheets("DATA").Range("F" & Rows.Count).End(3).Row + 1
Sheets("DATA").Range("F" & iRow).Value = Application.WorksheetFunction.Transpose(Res)
End Sub

 

[THEsewingmaster]

edit

Progress...
That runs with no error, but two things I noticed.
1. If both lists are the same, then I delete 3 items off on DATA. Then run the macro, it will add 1 of 3 missing items to DATA. I have to run the macro 2 other times to get the other 2 missing data added to DATA.
2. If all data is found on both sheets, it gives a "invalid procedure call / argument" error.

Thanks for your help!!

 

[THEsewingmaster]

So, interesting test... I made a quick stripped down version of my file to send, but then I was testing the stripped down file, and IT WORKED FLAWLESSLY (no error, and all data transferred). It was quick, and didn't have any of the issues that I experienced on the original.

Comparing the two...

• The R_STATUS_LIST table on the test file is just a table, the table on the original is a query connection table.
• The data being transferred on the test file is a 2-digit alphanumeric, the data on the original is a 12-digit alphanumeric.
• The table in DATA has no connections on the test file, on the original it has one connection to another workbook on sharepoint (all though the connection is not referencing the data being transferred).

Thoughts?

 

[kokano90]

I can't speak English

 

[THEsewingmaster]

I can't speak English

In the demo file, everything works as you intended. No issues. The original and the test file have a few differences which may be giving me the headaches... See my previous reply.