Compare 2 arrays.

[MyHanhCB]

Hello everyone in the Mrexcel forum.
I am a foreigner, specifically Vietnamese, so my English may not be fluent. Anything offensive to me sorry.
I have an array A containing 15000 values, and an array B containing 10000 values. I want to find if each value in array A is in array B or not. If not, save that value in array C (array C is the value I'm looking for).
I use this 1 piece of code in my project. But it works quite slow.
Can you guys help me with an alternative code that can work faster?. Thank you very much.

Dim found As Boolean
        found = False
   o = 0
27    For i = LBound(rn1, 1) To UBound(rn1, 1)
     traRn1 = rn1(i, 1) & "#" & rn1(i, 2) & "#" & rn1(i, 3)
        For l = LBound(rn2, 1) To UBound(rn2, 1)
29     traRn2 = rn2(l, 1) & "#" & rn2(l, 2) & "#" & rn2(l, 3)
31 If traRn1 <> "##" Or traRn2 <> "##" Then
            If traRn1 = traRn2 Then
            found = True
                Exit For
                    End If
                        End If
                            Next l
33 If traRn1 <> "##" Or traRn2 <> "##" Then
            If Not found Then
                    o = o + 1
                    ReDim Preserve so(1 To o)
                    so(o) = rn1(i, 1) & "_" & rn1(i, 2)
                        End If
                            End If
                                found = False
                                    Next i

 

[MyHanhCB]

I don't know where to attach data files? to be able to share with you, on the Mrexcel interface. please just help me.

 

[MyHanhCB]

Thank you for all your enthusiasm. Below is my entire project, and maybe also solve part of my work. Wishing everyone in the Mrexcel forum good health.

Option Explicit
Public k, j As Integer
Sub tk()
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'On Error GoTo ThongBao
    Dim fileExplorer As FileDialog
    Dim fileList() As String, name As String
    Dim wb As Workbook, ws As Worksheet, t&
                t = Timer
    Dim fso As Object, dic As Object, arr1(), so(), rn1() As String, rn2() As String
    Dim traRn1, traRn2 As Variant, i%, o%, l%, lr%
    Set dic = CreateObject("Scripting.Dictionary")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
If MsgBoxUni(VNItoUNICODE("Laáy Thoâng Tin SDC Chöa Kyù"), vbYesNo) = vbYes Then
    With fileExplorer
        .Title = "Local File"
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "excel file", "*.xlsx"
        .InitialFileName = ""
        If .Show <> -1 Then Exit Sub
1        ReDim fileList(1 To .SelectedItems.Count)
            For i = 1 To .SelectedItems.Count
                fileList(i) = .SelectedItems(i)
            Next i
    End With
    i = 1
While i <= UBound(fileList)
        Set wb = Workbooks.Open(fileList(i))
5        Set ws = wb.Sheets(1)
      With ws
        lr = .Range("A" & Rows.Count).End(xlUp).Row
7 arr1 = .Range("B5:D" & lr).Value
If i = 1 Then ReDim rn1(1 To (UBound(arr1, 1) * UBound(fileList)), 1 To i)
If i > 1 Then ReDim Preserve rn1(1 To UBound(rn1), 1 To i)
9                For o = 1 To UBound(arr1, 1)
                    If Not dic.exists(arr1(o, 1) & "#" & arr1(o, 2) & "#" & arr1(o, 3)) Then
    k = k + 1
11    dic.Add arr1(o, 1) & "#" & arr1(o, 2) & "#" & arr1(o, 3), k
    rn1(k, 1) = arr1(o, 1) & "(" & arr1(o, 2) & ")" & "#" & arr1(o, 3) & "#" & 1
    Else
    l = dic.Item(arr1(o, 1) & "#" & arr1(o, 2) & "#" & arr1(o, 3))
    rn1(l, 1) = Left(rn1(l, 1), Len(rn1(l, 1)) - 1) & Right(rn1(l, 1), 1) + 1
                    End If
                Next o
13            wb.Close False
        End With
    i = i + 1
Wend
End If
        dic.RemoveAll: l = 0
'---------------------------------------
If MsgBoxUni(VNItoUNICODE("Laáy Thoâng Tin SDC Ñaõ Kyù"), vbYesNo) = vbYes Then
    With fileExplorer
        .Title = "Local File"
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "excel file", "*.xlsx"
        .InitialFileName = ""
        If .Show <> -1 Then Exit Sub
15        ReDim fileList(1 To .SelectedItems.Count)
            For i = 1 To .SelectedItems.Count
                fileList(i) = .SelectedItems(i)
            Next i
    End With
    i = 1
While i <= UBound(fileList)
        Set wb = Workbooks.Open(fileList(i))
17        Set ws = wb.Sheets(1)
      With ws
        lr = .Range("A" & Rows.Count).End(xlUp).Row
arr1 = .Range("B5:D" & lr).Value
    If i = 1 Then ReDim rn2(1 To (UBound(arr1, 1) * UBound(fileList)), 1 To i)
    If i > 1 Then ReDim Preserve rn2(1 To UBound(rn2, 1), 1 To i)
                For o = 1 To UBound(arr1, 1)
21                    If Not dic.exists(arr1(o, 1) & "#" & arr1(o, 2) & "#" & arr1(o, 3)) Then
    j = j + 1
23    dic.Add arr1(o, 1) & "#" & arr1(o, 2) & "#" & arr1(o, 3), j
    rn2(j, 1) = arr1(o, 1) & "(" & arr1(o, 2) & ")" & "#" & arr1(o, 3) & "#" & 1
    Else
    l = dic.Item(arr1(o, 1) & "#" & arr1(o, 2) & "#" & arr1(o, 3))
    rn2(l, 1) = Left(rn2(l, 1), Len(rn2(l, 1)) - 1) & Right(rn2(l, 1), 1) + 1
                    End If
25                Next o
            wb.Close False
        End With
    i = i + 1
Wend
Else
    Exit Sub
End If
    
'--------------------------------------------
27            With ThisWorkbook.Sheets(1)
                .Columns("C:C").Clear
            i = 2
            .Range("B2").Resize(UBound(rn2, 1), 1).Value = rn2
            lr = .Range("B" & Rows.Count).End(xlUp).Row
29            For o = 1 To UBound(rn1, 1)
            If rn1(o, 1) <> "" Then
                If WorksheetFunction.CountIf(.Range("B2:B" & lr), rn1(o, 1)) = 0 Then
                 .Range("C" & i) = Replace(Left(rn1(o, 1), Len(rn1(o, 1)) - 2), "#", "_")
                 i = i + 1
                 End If
                    End If
                    Next o
31                 .Columns("A:B").Clear
            End With
'----------------------------------------------
'                       JoeMo Mrexcel
'Dim x As Variant, vung() As Variant
'o = 0
'            With ThisWorkbook.Sheets(1)
'           .Range("B2").Resize(UBound(rn2, 1), 1).Value = rn2
'            vung = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
'            ReDim so(1 To UBound(rn1, 1), 1 To 1)
'                For i = 1 To UBound(rn1, 1)
'                    x = Application.Match(rn1(i, 1), vung, 0)
'                        If IsError(x) Then
'                            o = o + 1
'                            so(o, 1) = rn1(i, 1)
'                        End If
'                Next i
'                If o > 0 Then
'                    .Range("C:C").ClearContents
'                    .Range("C2:C" & o + 1).Value = so
'                Else
'                    MsgBox "All values in arA can be found in arB"
'
'                End If
'            End With
    '--------------------------------

                    dic.RemoveAll
33    Call edit_name
     MsgBoxUni (VNItoUNICODE("Hoaøn Thaønh Thoáng Keâ")) & "   " & Timer - t & "s", vbInformation
LoiCT: k = 0:     j = 0:  Erase rn1, rn2, arr1
    Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
Exit Sub
ThongBao:
 MsgBox Error, , Erl
 Resume LoiCT
End Sub

 

[Peter_SSs]

Yes, thanks for your help. Thank you very much.

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.