VB Code to reorganize data

hELLO rIZ,

Okay, this macro will check the contents of cell K1. If the cell does not contain a Date, it will exit silently. If the Date cannot be found, a message will be displayed.

Sub ReOrganizeByDay()

    Dim Col     As Variant
    Dim Data    As Variant
    Dim DstRng  As Range
    Dim DTRng   As Range
    Dim Row     As Long
    Dim SrcRng  As Range
    Dim Wks     As Worksheet
    
        Set Wks = ThisWorkbook.Worksheets("Sheet1")
        
        Set DTRng = Wks.Range("K1")
        If IsEmpty(DTRng) Then Exit Sub
        
        Set SrcRng = Wks.Cells.Find(DTRng.Value, DTRng, xlFormulas, xlWhole, xlByRows, xlNext, False, False, False)
        If SrcRng.Address = DTRng.Address Then
            MsgBox "The Clock-In/Out date and time """ & DTRng.Text & """ was Not Found.", vbExclamation
            Exit Sub
        End If
        
        Set SrcRng = SrcRng.CurrentRegion
        
        Set DstRng = Wks.Range("A3")
                
            ReDim Data(SrcRng.Rows.Count, 3)
            
            For Col = 1 To 3
            
                For Row = 2 To SrcRng.Rows.Count
                    Set Cell = SrcRng.Cells(Row, 1)
                    Data(Row - 2, 0) = SrcRng.Cells(1, 1)
                    Data(Row - 2, 1) = Cell.Value
                    Data(Row - 2, 2) = Cell.Offset(0, 1).Value
                    Data(Row - 2, 3) = Cell.Offset(0, 2).Value
                Next Row
                
                DstRng.Resize(SrcRng.Rows.Count - 1, 4).Value = Data
            Next Col
        
End Sub