Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim LastCol As Long

   With Application

       .ScreenUpdating = False
       .Calculation = xlCalculationManual
   End With

   With ActiveSheet

       .Columns("A:F").Sort key1:=.Range("A1"), header:=xlYes
       LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
       For i = LastRow To 1 Step -1

           If .Cells(i, "A").Value = .Cells(i + 1, "A").Value Then

               If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

                   .Cells(i + 1, "C").Value = .Cells(i, "C").Value
               End If
               .Rows(i).Delete
           Else

               LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
               'If LastCol > 4 Then

                   .Cells(i, "D").Value = .Cells(i, LastCol).Value
                   If LastCol > 4 Then
                       .Cells(i, "E").Resize(LastCol - 4).ClearContents
                   End If
               'End If
           End If
       Next i

       .Range("C1:F1").Value = Array("Opened", "Closed", "", "")
       .Columns("C:D").NumberFormat = "hh:mm"
   End With

   With Application

       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
   End With

End Sub