Use reference sheet to autofill values (based on multiple conditions)

[SidKol]

Hi all,

This one has me puzzled like crazy
I just don't seem to get it right without writing a large book of code for all exceptions.

So here's the case:

I have a workbook with two sheets.
Sheet1 contains a large table (20.000 rows, 100 columns), but looks simplified like this:

The second sheet contains a reference table that looks (simplified) like this:

So from here i want some Excel-magic to happen.
This is to:
- Find exact values of column A, B and C from sheet1 in column A, B and C from sheet2
- Based on these values to return values for column E and F in Sheet1 from the Reference table in sheet 2

So the endresult in sheet 1 after running the code should be:

I have been able to make this work with workaround code that does not involve the reference table and looks like this:

Dim i As Long


For i = 1 To 20000
    With Sheets("sheet1")
        If .Range("A" & i).Text = "Car" And _
        .Range("B" & i).Text = "Green" And_
        .Range("C" & i).Text = "5" _
      Then _
       .Range("E" & i).Value = "Group 1"


        End With
Next i

Problem is that this way I have to include code for all possible combinations of columns A B and C.
Which is not an efficient way of working, requires a very large code + increases the chance of errors.
Especially given that the reference table will change frequently.

So hopefully any of you knows a way to integrate a comparison of the first three columns in both sheets to return these values from the reference table.

Any help is greatly appreciated. (and needed )

 

[MickG]

Try this:-
Results Sheet 1 columns "E & F"

[COLOR="Navy"]Sub[/COLOR] MG29Nov32
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    nStr = Dn.Value & Dn.Offset(, 1).Value & Dn.Offset(, 2).Value
    [COLOR="Navy"]If[/COLOR] Not .exists(nStr) [COLOR="Navy"]Then[/COLOR]
        .Add nStr, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(nStr) = Union(.Item(nStr), Dn)
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
 nStr = Dn.Value & Dn.Offset(, 1).Value & Dn.Offset(, 2).Value
    [COLOR="Navy"]If[/COLOR] .exists(nStr) [COLOR="Navy"]Then[/COLOR]
        .Item(nStr).Offset(, 4) = Dn.Offset(, 3).Value
        .Item(nStr).Offset(, 5).Value = Dn.Offset(, 4).Value
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[SidKol]

Mick, this is amazing.
Unbelievable. Thank you so much.
Such a great help!

I am trying to figure out what kind of magic is exactly going on in your code.
May take me some time. This is definitely a few levels above my VBA-knowledge.
Can you explain briefly in dummy-language what is going on here?
Would be great, I'd really like to not just use the code but also to understand it.

 

[MickG]

You're welcome
Its a bit complicated to explain, so print yourself a copy of the following, it a good starting point.
VBA for smarties: Dictionaries