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