BA/Excel: Identify specific associates based on time stamp

charlieboy92

New Member
Joined
Mar 10, 2017
Messages
2
Hi all!

Hoping to get some help with an Excel/VBA problem. I have a spreadsheet with associate names along with specific tasks as well as the time they said they completed their task.

As you can see in the picture, there are varying numbers of tasks per associate resulting in their names being listed several times over.

aLBd9.png

I'd like to somehow identify associates that are checking off these tasks at the same time. As you can see in the attached image, John Doe clicked off on everything at exactly 5:07.
My general idea is to have a spreadsheet with a button that will populate a list with the associates, such as John Doe, ticking off these boxes at the same time.
Now, I think I have the general concept down but it obviously needs refining. How might I identify these time stamps if they were within, say, a minute of one another?
Right now I'm converting the given time stamp to a value and then using COUNTIFS() to determine if there are multiples of the same stamp. Say the given value of the time stamp is 42901.32848903 (just an example), I'm using the first 7 digits.

Then if there are 2 or more of the same same, column X in a newly created sheet gets populated with a list of these names and column Y gets populated with a list of associates who did not time stamp at all.

Thank you in advance! I've attached my code below! Any tips on what I may have done poorly on this would be a big help as I'm pretty new to VBA. :)

Code:
[COLOR=#222222][FONT=Verdana]Sub DFL()[/FONT][/COLOR][/FONT][/COLOR]
'
' Populate sheet to reflect who is checking off tasks at the same time
'


'


'Copy of MyItems-030717.xlsx


Dim myitems As Workbook
Dim lastrow As Long


Set myitems = Workbooks.Open("C:\Users\me\Desktop\MyItems 030817 ORIGINAL.xlsx")


lastrow = Cells(Rows.count, 1).End(xlUp).Row


myitems.Sheets(1).Activate


ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("L1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:U920")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


'Convert date to value


For x = 2 To lastrow


    Cells(x, 22) = "=LEFT((VALUE(RC[-4])),8)"


Next


Range("V:V").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


'Determine multiple time stamps




For x = 2 To lastrow


    Cells(x, 23) = "=COUNTIFS(RC[-1]:R[918]C[-1],RC[-1],RC[-11]:R[918]C[-11], RC[-11])"


Next


Range("W:W").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


'If same time stamp is seen 2 or more times for a given associate, their name will appear in column X
'If an associate is missing timestamps altogether, their name will appear in column Y


For x = 2 To lastrow


    If Cells(x, 18) = "" Then Cells(x, 25) = Cells(x, 12)
    If Cells(x, 23) >= 2 And Cells(x, 18) <> "" Then Cells(x, 24) = Cells(x, 12)


Next




    Columns("X:X").Select
    ActiveSheet.Range("$X$1:$X$920").RemoveDuplicates Columns:=1, Header:=xlYes
    Columns("Y:Y").Select
    ActiveSheet.Range("$Y$1:$Y$920").RemoveDuplicates Columns:=1, Header:=xlNo
    


Range("X:X,Y:Y").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    Range("A1").Select
    activecell.FormulaR1C1 = "Duplicate Stamps"
    Range("B1").Select
    activecell.FormulaR1C1 = "No Stamps"
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:B1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    
myitems.Sheets(2).Activate


End Sub


[COLOR=#242729][FONT=Arial]
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

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