#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 51
Default 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.


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,355
Default 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.



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
close match [email protected] Excel Worksheet Functions 0 April 22nd 09 11:57 AM
Close Match [email protected] Excel Worksheet Functions 0 April 21st 09 08:35 PM
Close Match [email protected] Excel Programming 5 March 18th 09 04:23 PM
Finding a close match mailrail Excel Discussion (Misc queries) 3 September 30th 08 06:04 AM
VLOOKUP Closest Match Not Close Enough Ronster Excel Programming 11 December 15th 05 01:06 AM


All times are GMT +1. The time now is 05:55 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"