An Expert from EE was kind enough to provide a solution to a questioin/problem I  recently submitted. Functionally the solution works great but in further testing today, I found it's just too slow although I noted that speed was not initially a consideration so my fault for the misdirection. Was hoping someone knew a way to speed up the process?

The attached solution provided by the EE expert compares 2 columns each from 2 sheets (Master and Customer) and pastes the contents from C of the master into a column selected in the Customer sheet.

In the attached example. The search is for the Manufacturer and Model of a car and when a match is found on a row, it pastes the price from column C of the master into the Customer sheet in the selected column.

The problem I ran into is that I have a Master of 151,000 rows and even a small customer list still had 151,000 loops X the number of rows of on the customer list.

Hoping there is a faster way and if there is, i'm sure here is the place where someone would know.

The original question was 2013-01-06 at 22:33:54 ID: 27986700

swjtx99
compare-v6.xlsm
###### Who is Participating?

Commented:
In the original question I created a dictionary object solution (which would be considerably faster than the sheet method).
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27986700.html#a38753845

The single workbook is for speed testing the code.
It also demonstartes a simple formula solution too.
compare-lists-12-Dec-00.xls
compare-lists-12-Single-Workbook.xls
0

Older than dirtCommented:
I think the five bolded lines will speed up your process considerably.

Sub CompareLists()
Dim bkp_i As Long
Dim bkp_j As Long
Dim i As Long

'
Application.screenupdating = False
bkp_i = Sheets("Sheet1").Cells(3, 2).Value
For i = Sheets("Sheet1").Cells(3, 2).Value To Sheets("Sheet1").Cells(3, 3).Value
Sheets("Sheet1").Cells(3, 2) = i
bkp_j = Sheets("Sheet1").Cells(4, 2).Value
For j = Sheets("Sheet1").Cells(4, 2).Value To Sheets("Sheet1").Cells(4, 3).Value
Sheets("Sheet1").Cells(4, 2) = j
If Sheets("Sheet1").Cells(8, 2).Value = 1 Then ' There is a match!
' Short code portion to copy your values from Source to Destination Sheet
Sheets("Customer").Range(Cells(5, 2).Value & j).Value = Sheets("Master").Range("C" & i).Value
End If
Next j
Sheets("Sheet1").Cells(4, 2).Value = bkp_j
Next i
Sheets("Sheet1").Cells(3, 2).Value = bkp_i
Application.screenupdating = True
End Sub
0

Older than dirtCommented:
BTW using two variables that differ only by the last letter being a lower case j or i is very error prone due to their similarity.
0

Older than dirtCommented:
I missed j (see what I mean).

Dim j as Long
0

Author Commented:
Hi MartinLiss,

So it should be like this?

Sub CompareLists()
Dim bkp_i As Long
Dim bkp_j As Long
Dim i As Long
Dim j as Long
'
Application.screenupdating = False
bkp_i = Sheets("Sheet1").Cells(3, 2).Value
For i = Sheets("Sheet1").Cells(3, 2).Value To Sheets("Sheet1").Cells(3, 3).Value
Sheets("Sheet1").Cells(3, 2) = i
bkp_j = Sheets("Sheet1").Cells(4, 2).Value
For j = Sheets("Sheet1").Cells(4, 2).Value To Sheets("Sheet1").Cells(4, 3).Value
Sheets("Sheet1").Cells(4, 2) = j
If Sheets("Sheet1").Cells(8, 2).Value = 1 Then ' There is a match!
' Short code portion to copy your values from Source to Destination Sheet
Sheets("Customer").Range(Cells(5, 2).Value & j).Value = Sheets("Master").Range("C" & i).Value
End If
Next j
Sheets("Sheet1").Cells(4, 2).Value = bkp_j
Next i
Sheets("Sheet1").Cells(3, 2).Value = bkp_i
Application.screenupdating = True
End Sub

Thanks. I'm not sure what this is doing exactly but wondering if the logic is such that it's grabbing a data set from the master list then looking for the match in the customer list vs. the other way around. If so, changing that that might speed it up since it wouldn't have to go through all 151,000 lines in the master, it could quit as soon as it found the match.

Does that make sense?

Just tested the file as posted and the time went from ~16 seconds to 4 seconds. Nice improvement! Thanks,

swjtx99
0

Commented:
Hi

try this

``````Sub kTest()

Dim MstrData, CstrData, p
Dim i   As Long, dic As Object

Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1

MstrData = Worksheets("Master").Range("a1").CurrentRegion.Resize(, 3).Value2

For i = 1 To UBound(MstrData, 1)
If Len(MstrData(i, 1)) * Len(MstrData(i, 2)) * Len(MstrData(i, 3)) Then
dic.Item(MstrData(i, 1) & "|" & MstrData(i, 2)) = MstrData(i, 3)
End If
Next
Erase MstrData

CstrData = Worksheets("Customer").Range("a1").CurrentRegion.Resize(, 7).Value2
For i = 1 To UBound(CstrData, 1)
p = dic.Item(CstrData(i, 6) & "|" & CstrData(i, 3))
CstrData(i, 7) = p
Next
Worksheets("Customer").Range("a1").CurrentRegion.Resize(, 7) = CstrData

End Sub
``````

Kris
0

Older than dirtCommented:
Hi MartinLiss,

So it should be like this?

Sub CompareLists()
Dim bkp_i As Long
Dim bkp_j As Long
Dim i As Long
Dim j as Long
'
Application.screenupdating = False
bkp_i = Sheets("Sheet1").Cells(3, 2).Value
For i = Sheets("Sheet1").Cells(3, 2).Value To Sheets("Sheet1").Cells(3, 3).Value
Sheets("Sheet1").Cells(3, 2) = i
bkp_j = Sheets("Sheet1").Cells(4, 2).Value
For j = Sheets("Sheet1").Cells(4, 2).Value To Sheets("Sheet1").Cells(4, 3).Value
Sheets("Sheet1").Cells(4, 2) = j
If Sheets("Sheet1").Cells(8, 2).Value = 1 Then ' There is a match!
' Short code portion to copy your values from Source to Destination Sheet
Sheets("Customer").Range(Cells(5, 2).Value & j).Value = Sheets("Master").Range("C" & i).Value
End If
Next j
Sheets("Sheet1").Cells(4, 2).Value = bkp_j
Next i
Sheets("Sheet1").Cells(3, 2).Value = bkp_i
Application.screenupdating = True
End Sub
Yes.
0

Author Commented:
Trying these possibilities one at a time.

Kris, can you answer a couple of questions on how to change the code to match A and B to selected columns on the customer sheet?

Sub kTest()

Dim MstrData, CstrData, p
Dim i   As Long, dic As Object

Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1

MstrData = Worksheets("Master").Range("a1").CurrentRegion.Resize(, 3).Value2

For i = 1 To UBound(MstrData, 1)
If Len(MstrData(i, 1)) * Len(MstrData(i, 2)) * Len(MstrData(i, 3)) Then
dic.Item(MstrData(i, 1) & "|" & MstrData(i, 2)) = MstrData(i, 3)
End If
Next
Erase MstrData

CstrData = Worksheets("Customer").Range("a1").CurrentRegion.Resize(, 7).Value2
For i = 1 To UBound(CstrData, 1)
p = dic.Item(CstrData(i, 6) & "|" & CstrData(i, 3)) 'assume this is matching A to 6 (F) and B to 3 (C). If the customer list had the data I needed to compare in D and E, would I just change the 6 and 3 to 4 and 5?
CstrData(i, 7) = p 'I assume this is where the data is copied to 7=G? If I wanted to copy to column H would I just change from 7 to 8?
Next
Worksheets("Customer").Range("a1").CurrentRegion.Resize(, 7) = CstrData 'Not sure what this is doing, is it just resizing the column to autofit the data copied into it?

End Sub
0

Commented:
My code (which is obtained from Here thanks to Patrick) is already coded for the double dictionary method.
I am just not sure why you ingnored my solution from the last question and now seem to be ignoring it again.
0

Author Commented:
Hi The_Barman,

I apologize for missing this in the original question. I didn't realize the 2nd attachment was also a solution and only focused on the 1 workbook attachment. I'm testing it now and it is very very fast. The first run through I got some strange results. The "price" was copied over to the customer list but it wasn't the same as what was on the master. Example, for a specific MFG - Model combination, the price was 79, for that item on the customer list after the run, the value that was 4334. Not sure what happened but I'm resetting and trying again. Likely I did something wrong.  I'll update again when I've had a chance to run.

Thank you and sorry again I missed this the first time around.

swjtx99
0

Commented:
Hi

this will give you full control.

``````Sub kTest()

Dim MstrData, CstrData, p, rngCustr As Range
Dim i   As Long, dic As Object

Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1

Const Mfg_Mstr_Col  As Long = 1
Const Mdl_Mstr_Col  As Long = 2
Const Prc_Mstr_Col  As Long = 3

Const Mfg_Cstr_Col  As Long = 6
Const Mdl_Cstr_Col  As Long = 3
Const Prc_Cstr_Col  As Long = 7

MstrData = Worksheets("Master").Range("a1").CurrentRegion.Resize(, 3).Value2 'range A:C

For i = 1 To UBound(MstrData, 1)
If Len(MstrData(i, Mfg_Mstr_Col)) * Len(MstrData(i, Mdl_Mstr_Col)) * Len(MstrData(i, Prc_Mstr_Col)) Then
dic.Item(MstrData(i, Mfg_Mstr_Col) & "|" & MstrData(i, Mdl_Mstr_Col)) = MstrData(i, Prc_Mstr_Col)
End If
Next
Erase MstrData

'Col A thru Col G. replace 7 with 8, if you want to put the price in col H
Set rngCustr = Worksheets("Customer").Range("a1").CurrentRegion.Resize(, 7)
CstrData = rngCustr.Value2

For i = 1 To UBound(CstrData, 1)
p = dic.Item(CstrData(i, Mfg_Cstr_Col) & "|" & CstrData(i, Mdl_Cstr_Col))
CstrData(i, Prc_Cstr_Col) = p
Next

rngCustr = CstrData

End Sub
``````

Kris
0

Commented:
The double dictionary I have applied is way faster than the original question answer. But I am a firm believer in Keep It Simple... and for that Kris has a very elegant single dictionary solution which will do the same task with simple ellegance. The Double Dictioary may be overkill for this requirement.
Without Kris's solution I would say mine is the way to go, but I favour the single dictionary with joined values as it is cleaner and easier to understand.
I was just wondering why my efforts were apperently being ignored :)

ATB
Steve.
0

Author Commented:
Hi The_Barman (AKA Steve)

I figured out the problem I was having during the first run as mentioned above. I had duplicates in my "master list" so the result was the sum of all matches in the master list. In other words, if I had two duplicates in the master list that were both \$50, then each item on the customer list would get \$100. etc.

Now having made a fool of myself :-) for not understanding your original answer, I'm faced with how to close this question out equitably. Actually Kris's solution is a great update to the single workbook approach and I can certainly find plenty of uses for that as well as for the 2 workbook solution so I'm hoping it will be fair to split the points?

Martinliss's suggestion helped somewhat but didn't significantly change the run time as my "master" lists are almost all 100K rows but I do appreciate that he took the time to review my question and offer the suggestion.

I'm not aware of any guide on awarding points so if I'm doing this incorrectly, please let me know.

Thanks again,

swjtx99
0

Older than dirtCommented:
You don't seem to have awarded any points. I'm happy with any fraction of them.
0

Commented:
It is not all about points for the experts, it is about helping others, so however you decide to allocate points is fine with me.

So if you are happy with an answer (I am happy to help tidy it up a bit more if you need) feel free to close the question awarding points based upon the assistance provided overall by each expert.

ATB
Steve.
0

Author Commented:
Sorry for the delay. Computer fritzing out.

Thanks again for all the help. There are several solutions I can use for different scenarios so actually they are all very good.

swjtx99
0

Older than dirtCommented:
You're welcome and I'm glad I was able to help.

Marty - MVP 2009 to 2012
0

Commented:
Happy to be able to assist.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.