How do I delete duplicates between two excel sheets quickly vba
- by MainTank
I am using vba and I have two sheets one is named "Do Not Call" and has about 800,000 rows of data in column A. I want to use this data to check column I in the second sheet, named "Sheet1". If it finds a match I want it to delete the whole row in "Sheet1". I have tailored the code I have found from a similar question here: Excel formula to Cross reference 2 sheets, remove duplicates from one sheet and ran it but nothing happens. I am not getting any errors but it is not functioning.
Here is the code I am currently trying and have no idea why it is not working
Option Explicit
Sub CleanDupes()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim keyColA As String
Dim keyColB As String
Dim rngA As Range
Dim rngB As Range
Dim intRowCounterA As Integer
Dim intRowCounterB As Integer
Dim strValueA As String
keyColA = "A"
keyColB = "I"
intRowCounterA = 1
intRowCounterB = 1
Set wsA = Worksheets("Do Not Call")
Set wsB = Worksheets("Sheet1")
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value)
Set rngA = wsA.Range(keyColA & intRowCounterA)
strValueA = rngA.Value
If Not dict.Exists(strValueA) Then
dict.Add strValueA, 1
End If
intRowCounterA = intRowCounterA + 1
Loop
intRowCounterB = 1
Do While Not IsEmpty(wsB.Range(keyColB & intRowCounterB).Value)
Set rngB = wsB.Range(keyColB & intRowCounterB)
If dict.Exists(rngB.Value) Then
wsB.Rows(intRowCounterB).delete
intRowCounterB = intRowCounterB - 1
End If
intRowCounterB = intRowCounterB + 1
Loop
End Sub
I apologize if the above code is not in a code tag. This is my first time posting code online and I have no idea if I did it correctly.
