close match

[fi.or.jp.de]

Hi All,

I have two sheets ( sheet1 and sheet2)


Sheet1 Col A has Client name ( unique ) - Approximately 20,000 Rows


Sheet 2 Col A has Client name and Col B has Accounts - Approximately
100,000 Rows


I have created macro to look the Client name available in Sheet 1 col
A with Sheet2 col A,
If it matches then sheet2 Col B result will be populated in Sheet1
Col
A.
Below macro searches wtih wild card entry.


If Cell A2 ( sheet1) has = ABC
Sheet2 Col A has many names starts with ABC like ABC corp, ABC
Ltd,
Public ABC etc....


So, Sheet1 must have all the 3 accounts data in Col B.


Sub close_match()
Worksheets("sheet1").Activate
Set wb = Worksheets("sheet2")
Rng = Cells(Rows.Count, "A").End(xlUp).Row
rng1 = wb.Cells(Rows.Count, "A").End(xlUp).Row


For i = 2 To Rng
Cells(i, "A").Select
For a = 2 To rng1
If Cells(i, "A") Like wb.Cells(a, "A") Then
res = wb.Cells(i, "B")
result = result & "," & res
End If
Next a
With Application.WorksheetFunction
Cells(i, "B") = .Substitute(result, ",", "", 1)
End With
result = ""
Next i
End Sub


This macro is very slow, approximately for every minute it gives only
60 rows records.
As I have more 20,000 rows. The above needs to be changed in such
manner the work
need to be completed ASAP.


I kindly request all gurus of excel give me an suggestion run the
macro.


Thanks in advance.