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>

 

[CliffWeb]

Change lines as shown below:-

 'Change line below to 3
    For n =[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 = [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)

Thanks again I will test tonight and reply.

 

[CliffWeb]

I haven't had a chance to check the above with the actual worksheet yet, but I wondering if you can also help me on this http://www.mrexcel.com/forum/excel-...raws-raw-data-separate-sheet.html#post4607430

 

[MickG]

Try this for results on sheet1

[COLOR="Navy"]Sub[/COLOR] MG17Aug19
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Bk [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] P [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] ray(), Temp2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Tb [COLOR="Navy"]As[/COLOR] Double, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B4"), .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    temp = IIf(Dn.Offset(, -1).Value = "", temp, Dn.Offset(, -1).Value)
     [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) <> Temp2 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not Dic.exists(temp) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(temp) = CreateObject("Scripting.Dictionary")
        [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]If[/COLOR] Len(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not Dic(temp).exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                ReDim ray(1 To Rng.Count)
                Dic(temp).Add (Dn.Value), Array(ray, Dn.Offset(, 2), 1, "")
            [COLOR="Navy"]Else[/COLOR]
                Q = Dic(temp).Item(Dn.Value)
                  Q(0)(Q(2)) = Dn.Offset(, 2) - Dn.Offset(-1, 3)
                  Q(2) = Q(2) + 1
                  Q(3) = Dn.Offset(, 3)
                Dic(temp).Item(Dn.Value) = Q
            [COLOR="Navy"]End[/COLOR] If
     Temp2 = Dn.Offset(, 2)
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]End[/COLOR] If
 
[COLOR="Navy"]Next[/COLOR] Dn
   
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
   [COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
      .Cells(1, 1).Resize(, 7) = Array("Rep Name", "Date", "Total Hours Worked", "Total Break Time", "1st log in", "Last log out", "Total number of breaks")
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] P [COLOR="Navy"]In[/COLOR] Dic(k)
           c = c + 1
            .Cells(c, "A") = k
            .Cells(c, "B") = P
            .Cells(c, "C") = Format(Dic(k).Item(P)(3) - Dic(k).Item(P)(1), "h:mm")
            .Cells(c, "E") = Format(Dic(k).Item(P)(1), "h:mmAM/PM")
            .Cells(c, "F") = Format(Dic(k).Item(P)(3), "h:mmAM/PM")
           
           [COLOR="Navy"]For[/COLOR] R = 1 To UBound(Dic(k).Item(P)(0))
                [COLOR="Navy"]If[/COLOR] Len(Dic(k).Item(P)(0)(R)) [COLOR="Navy"]Then[/COLOR]
                    Num = Num + 1: oMax = Application.Max(oMax, Num)
                    .Cells(1, "G").Offset(, Num) = "Break (" & Num & ")"
                    .Cells(c, "G").Offset(, Num) = Format(Dic(k).Item(P)(0)(R) * 24 * 60, "0") & " Mins"
                    Tb = Tb + Dic(k).Item(P)(0)(R)
                [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]Next[/COLOR] R
                .Cells(20, 1) = Tb
                .Cells(c, "D") = Tb * 24 * 60 & " Mins"
                .Cells(c, "G") = Num: Num = 0
                Tb = 0
      [COLOR="Navy"]Next[/COLOR] P
  [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] k

 [COLOR="Navy"]With[/COLOR] Sheets("Sheet1").Cells(1, 1)
        [COLOR="Navy"]With[/COLOR] .Resize(c, oMax + 7)
             .Borders.Weight = 2
             .Columns.AutoFit
        [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[CliffWeb]

Mick Thanks again. The macro for the time sheet works but for some reason on the line A20 this shows up

0.041666667

<tbody>
</tbody>

 

[MickG]

Remove this line , it was there for testing !!!

Next R
               [B][/B][COLOR="#FF0000"] .Cells(20, 1) = Tb[/COLOR]               

                .Cells(c, "D") = Tb * 24 * 60 & " Mins"
                .Cells(c, "G") = Num: Num = 0
                Tb = 0
      Next P

 

[CliffWeb]

few things when running code for timesheet.
I received an error code
on Ln 44, col13
.Cells(c, "C") = Format(Dic(k).Item(P)(3) - Dic(k).Item(P)(1), "h:mm")

Sheet2 raw Data info
1. Some Reps work overnight they may clock in 8/17 but clock out 8/18 in the am. In these cases, the agents shows a break time of 949 mins in the breaks column.
2. The Raw data has a clock in date and clock out date. Would this help to remedy the above issue? Even though Some Reps Clock in and out on the same day.
3. The date Column on the (data) sheet2 is displayed as date/time in the same cell example: 8/1/2016 5:16:51 PM when the cell is clicked, but without Clicking on the cell it shows as 8/1/2016. The same thing with the Time column except without clicking on it, it shows the time example: 17:16.
4. The originally the Sheet2 had the Sign out Date Column which I took out in the example. This is the original Title Row without remove anything.

Agent(Name) Skill Sign in Date Sign In Time Sign Out date Sign out Time

Sheet 1 Info
1. Total Break Time is displayed at 17882.3000000103 Mins in the total hours worked column.
2. Please add a column for the sign out date.
3. The date column shows with date/time I only need date to show
4. Request: Can we have the break mins hyperlink to the location on sheet2? If Break1 is 15mins can you make that I can click on the 15mins and it takes me to it location on sheet2 ?
5. The break mins comes out fine. no problem there. Also the log in/out time shows fine.

I tried reading this code buy I have limited knowledge in vba. Still learning though.

 

[MickG]

I will have a look if you can provide a new set of data (file) that shows a complete example of the variety of these clockings with expected results. !!!

 

[CliffWeb]

Here is an updated version, The rep Jim Jones is an example of someone that works into the next day 6 pm to 1:30. in a extreme case may come back the same morning to work another 8hr shift from 9am to 5:30 pm.

https://app.box.com/s/x8xm1ezhatsxhz6myze7q1h6ev8yvih7

 

[CliffWeb]

I think I figured out this Mismatch error. If the rep has 1 log in for the entire day, the code returns a mismatch.

Mismatch error
on Ln 44, col13

.Cells(c, "C") = Format(Dic(k).Item(P)(3) - Dic(k).Item(P)(1), "h:mm")

I think I figured out this below also, The code is not dividing the displayed time in Column D by 24 then it should format it to h:mm time, before displaying it.

as of now the time is displayed as 17882.3000000103 Mins in the Total Break time in column D.

I believe it is apart of this code and I'm not sure how to fix it.

Next R
.Cells(20, 1) = Tb
.Cells(c, "D") = Tb * 24 * 60 & " Mins"
.Cells(c, "G") = Num: Num = 0
Tb = 0

 

[CliffWeb]

trying to delete this post