VBA remove duplicate not work on large data

BanhdaTr0n

New Member
Joined
Jun 16, 2021
Messages
6
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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.
VBA Code:
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

Well-known Member
Joined
Feb 1, 2016
Messages
3,469
Office Version
  1. 365
Platform
  1. Windows
However, I dont know why it also remove the header in A1.
Change this part:

VBA Code:
For i = 1 To UBound(vb, 1)

to this:

VBA Code:
For i = 2 To UBound(vb, 1)
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

BanhdaTr0n

New Member
Joined
Jun 16, 2021
Messages
6
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
It runs perfectly.
Thank you so much. Your code will save a lot of time.
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,469
Office Version
  1. 365
Platform
  1. Windows
You're welcome, glad to help & thanks for the feedback. :)
 

Forum statistics

Threads
1,144,370
Messages
5,723,964
Members
422,529
Latest member
mbilal429

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top