VBA remove duplicate not work on large data

[BanhdaTr0n]

Hi,
I have this VBA that find duplicate for example in Column A from Sheet1 and delete entire row that Column A has that value in Sheet2.
It used to work fine with data that has about 200K rows but when it comes up with 1M rows. It only delete the first row and ignore the other.
Can someone take a look and explain what's the problem in my VBA.

Option Explicit
Sub CleanDupes()
    Dim targetArray, searchArray
    Dim targetRange As Range
    Dim x As Long

    'Update these 4 lines if your target and search ranges change
    Dim TargetSheetName As String: TargetSheetName = "Sheet2"
    Dim TargetSheetColumn As String: TargetSheetColumn = "A"
    Dim SearchSheetName As String: SearchSheetName = "Sheet1"
    Dim SearchSheetColumn As String: SearchSheetColumn = "A"

    'Load target array
    With Sheets(TargetSheetName)
        Set targetRange = .Range(.Range(TargetSheetColumn & "1"), _
                .Range(TargetSheetColumn & Rows.Count).End(xlUp))
        targetArray = targetRange
    End With
    'Load Search Array
    With Sheets(SearchSheetName)
        searchArray = .Range(.Range(SearchSheetColumn & "1"), _
                .Range(SearchSheetColumn & Rows.Count).End(xlUp))
    End With


    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    'Populate dictionary from search array
    If IsArray(searchArray) Then
        For x = 1 To UBound(searchArray)
            If Not dict.exists(searchArray(x, 1)) Then
                dict.Add searchArray(x, 1), 1
            End If
        Next
    Else
        If Not dict.exists(searchArray) Then
            dict.Add searchArray, 1
        End If
    End If

    'Delete rows with values found in dictionary
    If IsArray(targetArray) Then
        'Step backwards to avoid deleting the wrong rows.
        For x = UBound(targetArray) To 1 Step -1
            If dict.exists(targetArray(x, 1)) Then
                targetRange.Cells(x).EntireRow.Delete
            End If
        Next
    Else
        If dict.exists(targetArray) Then
            targetRange.EntireRow.Delete
        End If
    End If
End Sub

 

[Akuini]

However, I dont know why it also remove the header in A1.

Change this part:

For i = 1 To UBound(vb, 1)

to this:

For i = 2 To UBound(vb, 1)

 

[BanhdaTr0n]

It runs perfectly.
Thank you so much. Your code will save a lot of time.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.