VBA / macro to match multiple Criteria on two sheets then copy and paste cell value

[CliffWeb]

I need a macro to match/find Rep list and ID on Sheet 1 with Sheet 2 then copy and paste Skill Level from sheet 2 under the correct Skill on Sheet 1. I have a list of over 300 Reps and about 20 different skills and each skills has a levels ranging from 1-8. Below is a quick a example of how sheet 1 should look after comparing the list matching and copying the value from the Data to sheet 1. Sorry I don't know how to add the grid lines but Rep name is A3 and so on.

Sheet 1
Rep Name	Rep ID	1510	1511	1512	1516	1517	1688
Rep 1	Rep ID 1				6	1	2
Rep 2	Rep ID 2	4	3	5
Rep 3	Rep ID 3	5			3		2
Rep 4	Rep ID 4	3		4	1
Rep 5	Rep ID 5		3			1	1
Sheet 2 Data Sheet
Rep Name	Rep ID	Skill01	Skill01 Lvl	Skill02	Skill02 Lvl	Skill03	Skill03 Lvl
Rep 1	Rep ID 1	1517	1	1688	2	1516	6
Rep 2	Rep ID 2	1510	4	1511	3	1512	5
Rep 3	Rep ID 3	1688	2	1516	3	1510	5
Rep 4	Rep ID 4	1516	1	1510	3	1512	4
Rep 5	Rep ID 5	1511	3	1517	1	1688	1

<tbody>
</tbody>

 

[MickG]

Try this for Results in sheet1.

[COLOR="Navy"]Sub[/COLOR] MG15Aug53
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant

Ray = Sheets("Sheet2").Range("A3").CurrentRegion
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
        Txt = Ray(n, 1) & Ray(n, 2)
            [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Txt) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Txt) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]For[/COLOR] ac = 3 To UBound(Ray, 2) [COLOR="Navy"]Step[/COLOR] 2
                [COLOR="Navy"]If[/COLOR] Not Dic(Txt).Exists(Ray(n, ac)) [COLOR="Navy"]Then[/COLOR]
                    Dic(Txt).Add (Ray(n, ac)), Ray(n, ac + 1)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] ac
    [COLOR="Navy"]Next[/COLOR] n
   
[COLOR="Navy"]Set[/COLOR] Rng = Sheets("Sheet1").Range("A3").CurrentRegion
[COLOR="Navy"]For[/COLOR] n = 4 To Rng.Count
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
        [COLOR="Navy"]If[/COLOR] Dic.Exists(.Range("A" & n).Value & .Range("B" & n).Value) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(.Range("A" & n).Value & .Range("B" & n).Value)
                Col = Application.Match(p, Rng(1).Offset(1).Resize(, Rng.Columns.Count), 0)
                Sheets("Sheet1").Cells(n, Col) = _
                Dic(.Range("A" & n).Value & .Range("B" & n).Value).item(p)
            [COLOR="Navy"]Next[/COLOR] p
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[CliffWeb]

Thanks Mick, Everything works below Rep 1. For some reason rep one row is not filling in. If you don't mind can you fill me on what the code is doing or where it is doing it? because I may have to alter the Col, location for the the Skill01 and so on. Because of the raw data has more Columns in between the rep ID and and where Skillo1 is located. example Skill01 on the raw data actually starts on H Column. The rest of the Skills and Lvl continues from there on.

 

[MickG]

I assumed that "Rep Name " in both sheets started in "A3", that might be the problem.

The code should take account of various numbers of columns and rows, if you are still having problems , perhaps you could show a more realistic example of your data, or send an Example file via "Box.com" (Free file sharing).

The code is basically taking all the data in sheet2 and comparing it with sheet1 columns "A & B", then matching the "Skill" numbers in sheet 2 with the headers in sheet 1 row 3. and allocating the sheet 2 values.

 

[CliffWeb]

I assumed that "Rep Name " in both sheets started in "A3", that might be the problem.

The code should take account of various numbers of columns and rows, if you are still having problems , perhaps you could show a more realistic example of your data, or send an Example file via "Box.com" (Free file sharing).

The code is basically taking all the data in sheet2 and comparing it with sheet1 columns "A & B", then matching the "Skill" numbers in sheet 2 with the headers in sheet 1 row 3. and allocating the sheet 2 values.

The Rep name does start on A3 for both sheets. Thanks for the explanation. I work is really appreciated.

 

[CliffWeb]

I meant to say your work is really appreciated.

 

[CliffWeb]

Ahh I see what you mean, it works perfectly.

 

[MickG]

You're welcome

 

[CliffWeb]

You're welcome

Mick, being that I can't take the original take from work to the net. I tried to give the best representation of the work itself, here is a closer representation of the Data sheet . I getting out of of script error. No changes needed to be made to the first sheet. I just wanted to expand on the Data sheet. I just got box here is a link. https://app.box.com/s/j4mki1oumxz1r1ggrudok9xvs9bniq87

 

[MickG]

Change lines as shown below:-

 'Change line below to 3
    For n =[B][/B][COLOR="#FF0000"][/COLOR][COLOR="#FF0000"][SIZE=5] 3 [/SIZE][/COLOR]To UBound(Ray, 1)
        Txt = Ray(n, 1) & Ray(n, 2)
            If Not Dic.Exists(Txt) Then
                Set Dic(Txt) = CreateObject("Scripting.Dictionary")
            End If
            'CHange code below to "6"
            For ac = [B][/B][COLOR="#FF0000"][SIZE=5]6[/SIZE][/COLOR] To UBound(Ray, 2) Step 2
                If Not Dic(Txt).Exists(Ray(n, ac)) Then
                    Dic(Txt).Add (Ray(n, ac)), Ray(n, ac + 1)