Solved

Excel Compare re-ask

Posted on 2013-01-10
18
305 Views
Last Modified: 2013-01-14
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

Thanks in advance.

swjtx99
compare-v6.xlsm
0
Comment
Question by:swjtx99
  • 6
  • 5
  • 5
  • +1
18 Comments
 
LVL 46

Assisted Solution

by:Martin Liss
Martin Liss earned 100 total points
ID: 38765827
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 46

Expert Comment

by:Martin Liss
ID: 38765832
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 46

Expert Comment

by:Martin Liss
ID: 38765835
I missed j (see what I mean).

Dim j as Long
0
ScreenConnect 6.0 Free Trial

Want empowering updates? You're in the right place! Discover new features in ScreenConnect 6.0, based on partner feedback, to keep you business operating smoothly and optimally (the way it should be). Explore all of the extras and enhancements for yourself!

 

Author Comment

by:swjtx99
ID: 38766019
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

by:krishnakrkc
ID: 38766141
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

Open in new window


Kris
0
 
LVL 24

Accepted Solution

by:
Steve earned 200 total points
ID: 38766154
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 46

Expert Comment

by:Martin Liss
ID: 38767532
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

by:swjtx99
ID: 38768402
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

by:Steve
ID: 38768580
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

by:swjtx99
ID: 38769180
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

by:krishnakrkc
krishnakrkc earned 200 total points
ID: 38769443
Hi

Your assumptions are right.

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

Open in new window


Kris
0
 
LVL 24

Expert Comment

by:Steve
ID: 38769595
swjtx99, that is fine, I just want to make sure you get the best solution possible.
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

by:swjtx99
ID: 38770464
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 46

Expert Comment

by:Martin Liss
ID: 38770584
You don't seem to have awarded any points. I'm happy with any fraction of them.
0
 
LVL 24

Expert Comment

by:Steve
ID: 38771772
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.

I am more concerned with ensuring you get the best solution to your task.

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

by:swjtx99
ID: 38776827
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 46

Expert Comment

by:Martin Liss
ID: 38776835
You're welcome and I'm glad I was able to help.

Marty - MVP 2009 to 2012
0
 
LVL 24

Expert Comment

by:Steve
ID: 38777227
Happy to be able to assist.
0

Featured Post

ScreenConnect 6.0 Free Trial

At ScreenConnect, partner feedback doesn't fall on deaf ears. We collected partner suggestions off of their virtual wish list and transformed them into one game-changing release: ScreenConnect 6.0. Explore all of the extras and enhancements for yourself!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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,…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

832 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question