close match
 

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.

close match
 

I've tweaked, but can't test without real data. Try this

Option Explicit

Sub close_match()
Dim mySheet1 As Excel.Worksheet
Dim mySheet2 As Excel.Worksheet

Dim i As Long

Dim res As Variant
Dim result As Variant

Dim lRow As Long
Dim lRow1 As Long

Set mySheet1 = Worksheets("sheet1")
Set mySheet2 = Worksheets("sheet2")

lRow = mySheet1.Cells(Rows.Count, "A").End(xlUp).Row
lRow1 = mySheet2.Cells(Rows.Count, "A").End(xlUp).Row

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False


For i = 2 To lRow

'Cells(i, "A").Select
For a = 2 To lRow1
'Do the values in Sheet2 have * before and after to get the "like"
to work?
If mySheet1.Cells(i, "A") Like mySheet2.Cells(a, "A") Then
res = mySheet2.Cells(i, "B")
result = result & "," & res
End If
Next a
With Application.WorksheetFunction
mySheet1.Cells(i, "B") = .Substitute(result, ",", "", 1)
End With
result = ""
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub


" wrote:

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.