Solved

Posted on 2013-01-10
302 Views
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
0
Question by:swjtx99
• 6
• 5
• 5
• +1

LVL 45

Assisted Solution

Martin Liss earned 100 total points
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

LVL 45

Expert Comment

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

LVL 45

Expert Comment

I missed j (see what I mean).

Dim j as Long
0

Author Comment

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

LVL 18

Expert Comment

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

LVL 24

Accepted Solution

Steve earned 200 total points
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

LVL 45

Expert Comment

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 Comment

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

LVL 24

Expert Comment

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 Comment

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

LVL 18

Assisted Solution

krishnakrkc earned 200 total points
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

LVL 24

Expert Comment

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 Comment

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

LVL 45

Expert Comment

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

LVL 24

Expert Comment

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 Closing Comment

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

LVL 45

Expert Comment

You're welcome and I'm glad I was able to help.

Marty - MVP 2009 to 2012
0

LVL 24

Expert Comment

Happy to be able to assist.
0

## Featured Post

### Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
It was really hard time for me to get the understanding of Delegates in C#. I went through many websites and articles but I found them very clumsy. After going through those sites, I noted down the points in a easy way so here I am sharing that unde…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…