Solved

Excel Compare re-ask

Posted on 2013-01-10
18
302 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 45

Assisted Solution

by:Martin Liss
Martin Liss earned 100 total points
Comment Utility
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

by:Martin Liss
Comment Utility
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

by:Martin Liss
Comment Utility
I missed j (see what I mean).

Dim j as Long
0
 

Author Comment

by:swjtx99
Comment Utility
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
Comment Utility
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
Comment Utility
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

by:Martin Liss
Comment Utility
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
Comment Utility
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
Comment Utility
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
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:swjtx99
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

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

Expert Comment

by:Steve
Comment Utility
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
Comment Utility
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

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

Marty - MVP 2009 to 2012
0
 
LVL 24

Expert Comment

by:Steve
Comment Utility
Happy to be able to assist.
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

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…

763 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

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now