BalloutMoe
Board Regular
- Joined
- Jun 4, 2021
- Messages
- 137
- Office Version
- 365
- Platform
- Windows
Hello All, I am looking for some help. I have the below code that finds the Employee name and Day and loops through them to let me know who left early. However some guys clock out and clock back in (Lunch break) I would like to take that into account. Any way of adding this in or any ideas of how to go about it? Thank you
For example it will say (Nathan Oglesby took a lunch break from 1:49:27 PM to 2:20:18 PM and left at 6:00:00 PM)
or Trent Taylor took a lunch break from 12:54:15 PM to 1:28:26 PM and left at 6:00:00 PM
I hope I am clear. Thank you
For example it will say (Nathan Oglesby took a lunch break from 1:49:27 PM to 2:20:18 PM and left at 6:00:00 PM)
or Trent Taylor took a lunch break from 12:54:15 PM to 1:28:26 PM and left at 6:00:00 PM
I hope I am clear. Thank you
VBA Code:
Sub TestFindAll()
Dim SearchRange As Range
Dim FindWhat As Variant
Dim FoundCells As Range
Dim FoundCell As Range
Dim LastRowA As Long, LastRowJ As Long
Dim WS1 As Worksheet
Set WS1 = ThisWorkbook.Worksheets("DailyTimeSheet")
LastRowJ = WS1.Range("J" & WS1.Rows.Count).End(xlUp).Row
Debug.Print LastRowJ
Dim firstAddress As String
With ws
Dim tbl As ListObject: Set tbl = .Range("DailyTime").ListObject
Set SearchRange = tbl.ListColumns("EmployeeName").Range
End With
For t = 2 To LastRowJ
FindWhat = WS1.Range("J" & t)
Set FoundCells = SearchRange.Find(What:=FindWhat, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows)
If Not FoundCells Is Nothing Then
firstAddress = FoundCells.Address
Debug.Print "Found " & FoundCells.Value & " " & FoundCells.Offset(0, 2).Value
Do
If Not FoundCells.Offset(0, 2).Value = "Sat" And FoundCells.Offset(0, 5).Value < TimeValue("18:00:00") Then
Debug.Print FoundCells.Value & " left early on " & FoundCells.Offset(0, 2) & " at " & TimeValue(Format(FoundCells.Offset(0, 5).Value, "hh:mm:ss"))
End If
Set FoundCells = SearchRange.FindNext(FoundCells)
Debug.Print "Found " & FoundCells.Value & " " & FoundCells.Offset(0, 2)
Loop While Not FoundCells Is Nothing And FoundCells.Address <> firstAddress
End If
Next
End Sub
