compare two worksheets and delete duplicates

[wali]

Hello everyone,

i have two wordlists in two different worksheets "1" and "2". Now i want to delete those rows from worksheet "2" where entry of column A also exists in column A of worksheet "1". No changes should be made to the worksheet "1" but only to "2".

Second problem is that some words in column A of worksheet "2" have wrong spacing which causes problems in comparing both A columns. For example:

worksheet "1" Col. A
lovely
being proud of something
everyone
everybody

worksheet "2" Col. A
love ly
being proudof some thing
every one
someone

Now according to our example i would like to delet three rows in "2" because they are the same as in "1" but with other spacing. That would mean that according to our example, only the last entry of "2" will remain which is "someone" and others should be deleted.

By the way WS "1" contains 12000 entries and WS "2" contains 140,000 entries. In other columns there is also data but column "A"s should only be compared.=> compare cells of colums A and delet complete rows in "2" if entry of column A also exist in column A of WS "1".

I am uploading few rows dummy data as example.

Thank you very much for each help in advance.

[antoka05]

See attached file where I added this macro. I hope it can help you.

Sub Macro1()
   Dim sh1 As Worksheet
   Dim sh2 As Worksheet
   Dim lastRow As Long, r As Long
   Dim dic As Object, myKey As String
   Dim rangeToDel As Range
   
   On Error GoTo lblError
   Set dic = CreateObject("scripting.dictionary")
  
   Set sh1 = ThisWorkbook.Sheets("1")
   Set sh2 = ThisWorkbook.Sheets("2")
   
   lastRow = sh1.Cells(Rows.Count, "a").End(xlUp).Row
   For r = 1 To lastRow
      myKey = Replace(sh1.Cells(r, "a"), " ", "")
      If Not dic.exists(myKey) Then
         dic.Add Item:="", key:=myKey
      End If
   Next r
   
   lastRow = sh2.Cells(Rows.Count, "a").End(xlUp).Row
   For r = 2 To lastRow
      myKey = Replace(sh2.Cells(r, "a"), " ", "")
      If dic.exists(myKey) Then
         If rangeToDel Is Nothing Then
            Set rangeToDel = sh2.Cells(r, "a")
         Else
            Set rangeToDel = Union(rangeToDel, sh2.Cells(r, "a"))
         End If
      End If
   Next r
   
   rangeToDel.EntireRow.Delete
  
lblExit:
   Set rangeToDel = Nothing
   Set sh1 = Nothing
   Set sh2 = Nothing
   Set dic = Nothing
   Exit Sub

lblError:
   'Resume lblExit
   MsgBox ("Error: " & Err.Number & " - " & Err.Description)
   Resume lblExit
End Sub

Regards,
Antonio

[wali]

Dear Antonio,

thank you a million times. It was really a greate help. Thank you very much