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

C

CliffWeb

New Member
Joined
Aug 15, 2016
Messages
23
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 1Rep ID 1
Rep 2Rep ID 2
Rep 3Rep ID 3
Rep 4Rep ID 4
Rep 5Rep ID 5
Rep 1Rep ID 1
Rep 2Rep ID 2
Rep 3Rep ID 3
Rep 4Rep ID 4
Rep 5Rep 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>
 
Sort by date Sort by votes
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)
Click to expand...
Thanks again I will test tonight and reply.
 
Upvote 0

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
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
 
Upvote 0
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]
 
Last edited:
Upvote 0
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
 
Last edited:
Upvote 0
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.
 
Last edited:
Upvote 0
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. !!!
 
Upvote 0
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")
Click to expand...


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
Click to expand...
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA Code To Loop Through One Worksheet and Paste Certain Values Into Another
Replies
5
Views
140
Peter_SSs
Peter_SSs
L
  • Question Question
Macro to correct entries across multiple sheets
Replies
1
Views
188
Lux Aeterna
L
T
  • Question Question
VLookup Multiple Values to Rows
Replies
5
Views
542
Peter_SSs
Peter_SSs
S
  • Solved
VBA: Index Match formular with multiple criterias (lookup an value based on multiple criteria)
Replies
9
Views
804
Alex Blakenburg
A
K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
643
mumps
mumps

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top