Try this as an alternative:

Sub ClearEntries()
Dim i As Long
Dim LastRow As Long
Dim FoundRow As Long

Application.ScreenUpdating = False
LastRow = Range("A65536").End(xlUp).Row
For i = 1 To LastRow
FoundRow = 0
On Error Resume Next
FoundRow = Columns("B:B").Find(What:=Range("A" & i), _
After:=Range("B1"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Row
On Error GoTo 0
If Not FoundRow = 0 Then
Range("A" & i).ClearContents
End If
Next 'i
Application.ScreenUpdating = True
End Sub

This was fairly quick for me but I'd only got 20 rows of data to test with!
I suspect it will beat 2 hours.

Regards

Trevor



"GUS" wrote in message
...
I am using the macro below in order to compare two lists at column A and B
But the code is too slow
it takes 2 hours to complete (pentium IIII 2.4 GHz)
is there any idea for a faster way of comparing lists with 20.000 data in
a
row?

(The code delete any content at column A if find it at column A)

Sub Comparing()
Dim A As Range, B As Range, C As Range
Dim i%, y%, z%
Set A = Columns(1)
Set B = Columns(2)
i = 1: y = 1: z = 1
Do Until IsEmpty(A.Cells(i))
Do Until IsEmpty(B.Cells(y))
If A.Cells(i) = B.Cells(y) Then
A.Cells(i).ClearContents
z = z + 1: y = 1
Exit Do
End If
y = y + 1
Loop
i = i + 1: y = 1
Loop
End Sub