Delete Duplicate Email between Sheets

[Blessy Clara]

Hi

Please Help me with this

I have an Excel with Sheet named BUSINESS - which contains the complete Contact database of 258393 + Records and Email in Column K

I have an another Sheet Named Bounced , This contains a list of 7000+ Emails that have bounced back .

I wanna remove those Emails from my main Business Sheet, if it is found/matched with the emails in the bounced list.

Thank you

 

[pvr928]

Hi Blessy Clara

Here is the skeleton of a solution for you to adapt to your specific needs. Change the references where indicated. I recommend you save a different version of the spreadsheet before you trial my suggested solution.

With credits to MickG (https://www.mrexcel.com/forum/excel...ing-returned.html?highlight=pvr928+dictionary) and Paul Kelly (https://excelmacromastery.com/vba-dictionary/#Sorting_the_Dictionary).

Option Explicit
Sub RemoveDuplicatesFromList()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rBaseRng As Range
Dim rRedundRng As Range
Dim Dn As Range
Dim dn2 As Range
Dim Dict As Object
Dim i As Integer
Dim aArray()
'set Base list
Set ws = Sheet2 '<- change to appropriate sheet
Set rBaseRng = Range(ws.Range("A1"), ws.Range("A" & Rows.Count).End(xlUp)) '<- change to appropriate range of data
Set Dict = CreateObject("scripting.dictionary")
Dict.CompareMode = vbTextCompare
For Each Dn In rBaseRng
    'Dn.address added as dict.item
    Dict(Dn.Value) = Dn.Address
Next
Debug.Print "The number of items in the dictionary before any are removed is " & Dict.Count
'Set redundant list
Set ws2 = Sheet2 '<- change to appropriate sheet
Set rRedundRng = Range(ws2.Range("F1"), ws2.Range("F" & Rows.Count).End(xlUp)) '<- change to appropriate range of data
'Remove duplicate items
For Each dn2 In rRedundRng
    Dict.Remove dn2.Value
Next
    
Debug.Print "The number of items in the dictionary after some are removed is " & Dict.Count
aArray = Dict.Keys
ws2.Range("K1").Resize(Dict.Count, 1) = Application.Transpose(aArray)
End Sub

Cheers

pvr928

 

[Blessy Clara]

Hi pvr928

Thank you very much for the code

 

[pvr928]

You're welcome.

Cheers

pvr928