campare list too slow

  • Thread starter Thread starter GUS
  • Start date Start date
G

GUS

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
 
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,

You could set up a macro to do the following.

1. Create a dummy column with a number series from 1 to whatever
(20,000 in your example)
2. Set up a formula column with an If(A1=B1, 1,0)
3. Sort on the formula column
4. Delete or clear all column A rows where formula = 1
5. Resort on dummy column to regain your initial order
6. Clear the 2 added columns.

You can record a macro to set this up. Later you can edit the code to make
it smoother and more precise.

I like to use R1C1 formate so that the formula input line would be:
Range(Cells(1,3),Cells(20000,3).FormulaR1C1="=If(RC1=RC2,1,0)"

You'll need to use a Match or Find function to find the first '1'
(Or you could get creative and use a Count function)

And you can use the following to determine the total number of rows if the
number of rows is not always the same:

Dim lrow as Long
lrow = Cells(Rows.COUNT, "A").End(xlUp).Row

Range(Cells(1,3),Cells(lrow,3).......

And you should be able to do all of this without Select.

You may find this easier than it sounds, and relatively fast.
 
Trevors option takes approx 6 minutes.

Doing it with a function is faster, but you'll need a different formula

the formula you post works only if the data is EXACTLY the SAME in
length and sort order...


Following formula does it same as Trevors code.
C2 =IF(ISERROR(MATCH(A2,B$2:B$20000,0)),"",A2)

Turn autocalc OFF
Copy down
Press F9 to recalc
That takes about 2,5 minutes !!

Now Copy/PasteValues and you're done.


All in all a substantial improvement over the OP's 2 hours :)



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
Back
Top