• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Multiple Columns LookUp

Bomino

Bomino

Member
Hello Experts,
On this forum I've stumbled upon a code here that I tried to accommodate to my needs to no avail.
http://forum.chandoo.org/threads/lookup-multiple-columns-data-using-vba.32413/#post-192344
I was wondering if someone would tweak it or better please help me with a solution to my problem.
Here is what I would to achieve:
For example: from row2 to the lastrow in Sheet2:
If any combination of Ai&Ci&Di in sheet2 is found in Sheet1, then copy entire sheet 1 row and paste in sheet3; If Ai&Ci&Di is not found in sheet1 then highlight entire the row in sheet2.
I hope it makes sense. Attached is the file.
Thanks.
 

Attachments

  • LookUp.xlsb
    33.7 KB · Views: 4
Hi !
Bomino said:
If any combination of Ai&Ci&Di in sheet2 is found in Sheet1, then copy entire sheet 1 row and paste in sheet3
Click to expand...
Sheet3 should start from blank or just append new row with existing data ?

How many rows in real Sheet1 ?
​
 

How many rows in real Sheet1 ?

What to do with Sheet1 duplicate rows ?
For example for rows #5 to 7 : same DocumentID, Date and Name …
​
 
There could be tens of thousand of rows in Sheet1. There isn't supposed to be any duplicate rows. Rows# 5 to 7 have different rates (Columns M to P).
Thanks.
 
With your concatenation criterion DocumentID, Date & Name
in case of duplicates only last duplicate row will be copied to Sheet3
for example …

Do you agree in your sample only Sheet2 row #2 matches with Sheet1 ?
​
 
Yes Sir!
IF Any DocumentID, Date & Name in Sheet2 is found in Sheet1, then copy the whole row in Sheet1 and paste it in Sheet3. The Key here is DocumentID, Date & Name combination.
I hope it makes sense.
 

Yes but just to be clear as possible with that key
(aka DocumentID, Date & Name) from Sheet1 49 data rows
there are only 43 without duplicates !
So if a key have duplicates like for example Sheet1 rows #5 to 7
only row #7 (last duplicate row) will be pasted in Sheet3 for example …
​
 
That will work.
One other requirement is to have the "Not Found Rows" Key highlighted in Sheet2.
 
Try this :​
Code: 
Sub Demo()
 Const DL = "¤"
 Dim Dict As Object, Rg As Range, C, R&, K$, L&
 Set Dict = CreateObject("Scripting.Dictionary")
   Set Rg = Sheet1.UsedRange.Rows
        C = [{38,5,12}]
    For R = 2 To Rg.Count
        Dict(Join(Application.Index(Rg(R), , C), DL)) = R
    Next
     Sheet3.UsedRange.Offset(1).Clear
With Sheet2.UsedRange.Rows
              .Interior.ColorIndex = xlNone
        Application.ScreenUpdating = False
                                 C = [{1,3,4}]
                                 L = 1
    For R = 2 To .Count
            K = Join(Application.Index(.Item(R), , C), DL)
        If Dict.Exists(K) Then
            L = L + 1
            Rg(Dict(K)).Copy Sheet3.Cells(L, 1)
        Else
            .Item(R).Interior.ColorIndex = 36
        End If
    Next
        Application.ScreenUpdating = True
End With
     Dict.RemoveAll
 Set Dict = Nothing:  Set Rg = Nothing
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
Impressive! Thanks a lots for your patience.
What if I would like to add more column to the criteria?
Let's say the new key has become DocumentID, Date & Name + NewColumnCriteria. Let's assume its Column# is Xy.
Should I just add Xy to C in your code:
C=[{38,5,12,Xy}] and to C=[{1,3,4,Xy}]?

Thank you.
 
:awesome: Thank you so much Marc L.
I really appreciate your help. Now, I am going to try to understand the code and hopefully I will be able to make the Columns selection flexible ; i.e probably inserting a userform that would let Users to enter the criteria.

Once again thanks a lot.
 

Or criterion columns may be directly within a parameter worksheet
whatever by name or by index …​
 
@Marc L This is great, can it be altered so that the row pasted to Sheet3 from sheet1 is pasted on the same row in sheet3 that it came from in sheet1?

e.g
In the example sheet given, there is one match found in sheet1 on row 34, so need to paste match to sheet3 on row 34

Thanks
 
Last edited:

Instead of hard code columns array just use a parameter worksheet
to define key columns : code will read this parameter worksheet
for key columns array.​
 
Sheet4 as parameter worksheet :
• row #1 for Sheet1 key header columns
• rows #2 & 4 must stay empty
• row #3 for Sheet2 key header columns
• column A for title (optional)
• column B must stay empty
• first key header column start in column C, second in D, no blank …
• Whatever keys are a column index or a text header.
• Text headers must be exacts, respecting case, space, …

If any beep during execution, an issue is in this parameter worksheet :​
Code: 
Sub Demo2()
    Const DL = "¤"
    Dim C(1 To 2), R&, W, L&, V, Dict As Object, Rg As Range, K$
        C(1) = Sheet4.[C1].CurrentRegion.Value
        C(2) = Sheet4.[C3].CurrentRegion.Value
        If UBound(C(1), 2) <> UBound(C(2), 2) Then Beep: Exit Sub
    For R = 1 To 2
            W = Worksheets(R).UsedRange.Rows(1).Value
        For L = 1 To UBound(C(R), 2)
            If IsNumeric(C(R)(1, L)) Then
                If C(R)(1, L) > UBound(W, 2) Then Beep: Exit Sub
            Else
                V = Application.Match(C(R)(1, L), W, 0)
                If IsError(V) Then Beep: Exit Sub Else C(R)(1, L) = V
            End If
        Next
    Next
           Set Dict = CreateObject("Scripting.Dictionary")
             Set Rg = Sheet1.UsedRange.Rows
    For R = 2 To Rg.Count
        Dict(Join(Application.Index(Rg(R), , C(1)), DL)) = R
    Next
     Sheet3.UsedRange.Offset(1).Clear
With Sheet2.UsedRange.Rows
              .Interior.ColorIndex = xlNone
        Application.ScreenUpdating = False
                                 L = 1
    For R = 2 To .Count
            K = Join(Application.Index(.Item(R), , C(2)), DL)
        If Dict.Exists(K) Then
            L = L + 1
            Rg(Dict(K)).Copy Sheet3.Cells(L, 1)
        Else
            .Item(R).Interior.ColorIndex = 36
        End If
    Next
        Application.ScreenUpdating = True
End With
               Dict.RemoveAll
           Set Dict = Nothing:  Set Rg = Nothing
End Sub
You should Like it !
​
 
You must log in or register to reply here.
Back
Top