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

CliffWeb · Aug 15, 2016

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.



Rep 1	Rep ID 1
Rep 2	Rep ID 2
Rep 3	Rep ID 3
Rep 4	Rep ID 4
Rep 5	Rep ID 5



Rep 1	Rep ID 1
Rep 2	Rep ID 2
Rep 3	Rep ID 3
Rep 4	Rep ID 4
Rep 5	Rep ID 5

<tbody>
[TD="bgcolor: #00ffff, colspan: 4, align: center"]Sheet 1[/TD]

[TD="bgcolor: #00ffff"]Rep Name[/TD]
[TD="bgcolor: #00ffff"]Rep ID[/TD]
[TD="bgcolor: #00ffff, align: right"]1510[/TD]
[TD="bgcolor: #00ffff, align: right"]1511[/TD]
[TD="bgcolor: #00ffff, align: right"]1512[/TD]
[TD="bgcolor: #00ffff, align: right"]1516[/TD]
[TD="bgcolor: #00ffff, align: right"]1517[/TD]
[TD="bgcolor: #00ffff, align: right"]1688[/TD]

[TD="align: right"]6[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]

[TD="align: right"]4[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]5[/TD]

[TD="align: right"]5[/TD]

[TD="align: right"]3[/TD]

[TD="align: right"]2[/TD]

[TD="align: right"]3[/TD]

[TD="align: right"]4[/TD]
[TD="align: right"]1[/TD]

[TD="align: right"]3[/TD]

[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]

[TD="bgcolor: #00ff00, colspan: 5, align: center"]Sheet 2 Data Sheet[/TD]

[TD="bgcolor: #00ff00"]Rep Name[/TD]
[TD="bgcolor: #00ff00"]Rep ID[/TD]
[TD="bgcolor: #00ff00"]Skill01[/TD]
[TD="bgcolor: #00ff00"]Skill01 Lvl[/TD]
[TD="bgcolor: #00ff00"]Skill02[/TD]
[TD="bgcolor: #00ff00"]Skill02 Lvl[/TD]
[TD="bgcolor: #00ff00"]Skill03[/TD]
[TD="bgcolor: #00ff00"]Skill03 Lvl[/TD]

[TD="align: right"]1517[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1688[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]1516[/TD]
[TD="align: right"]6[/TD]

[TD="align: right"]1510[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]1511[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1512[/TD]
[TD="align: right"]5[/TD]

[TD="align: right"]1688[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]1516[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1510[/TD]
[TD="align: right"]5[/TD]

[TD="align: right"]1516[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1510[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1512[/TD]
[TD="align: right"]4[/TD]

[TD="align: right"]1511[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1517[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1688[/TD]
[TD="align: right"]1[/TD]

</tbody>

CliffWeb · Aug 16, 2016

MickG said:

Change lines as shown below:-

Code:

 '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 · Aug 16, 2016

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 · Aug 17, 2016

Try this for results on sheet1

Code:

[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 · Aug 17, 2016

Mick Thanks again. The macro for the time sheet works but for some reason on the line A20 this shows up [TABLE="width: 84"]
<tbody>[TR]
[TD="width: 84, align: right"]0.041666667[/TD]
[/TR]
</tbody>[/TABLE]

MickG · Aug 17, 2016

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

Code:

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 · Aug 18, 2016

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 · Aug 18, 2016

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 · Aug 18, 2016

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 · Aug 19, 2016

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 · Aug 19, 2016

trying to delete this post

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

CliffWeb

New Member

CliffWeb

New Member

Excel Facts

CliffWeb

New Member

MickG

MrExcel MVP

CliffWeb

New Member

MickG

MrExcel MVP

CliffWeb

New Member

MickG

MrExcel MVP

CliffWeb

New Member

CliffWeb

New Member

CliffWeb

New Member

Similar threads

Forum statistics

Share this page

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

New Member

New Member

Excel Facts

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock