Csdrhrt

I have this:

which is difficult to read, 'I' means time in and 'O' means time out.

I want to transform it like this:

I want to align each time in and time out to its respective employee ID and date. Thanks

EDIT

I's and O's in the first table aren't necessarily alternating, there may be 3 I's before its respective O show up.

The result should be:
1. missing values of time in and out should show as blank
2. editable so the user can fill out missing time ins or outs and;
3. the t

Create a Pivot Table from your data with the following configuration:

You'll probably also need to format the value as a Time:

And you may also want to display the Pivot Table in tabular format to yield the desired result:

Also turning off the display of Subtotals & Grand Totals:

Note that if there are multiple In/Out records per day per employee, this will only show the latest In or Out record (by virtue of aggregating with Max).

Well i wrote an ugly bit of VBA but it does seem to work. There is room for optimization as I see code repeated. It is currently hard coded to out put in the 7 column 2nd row.

Option Explicit



Sub I_O_single_line()



    Dim rng As Range

    Dim counter1 As Integer, counter2 As Integer, counter3 As Integer, LastRow As Integer, WriteRow As Integer, HeaderRow As Integer

    Dim wkb As Workbook

    Dim sht As Worksheet

    Dim Arr() As Variant



    Set wkb = ActiveWorkbook

    Set sht = wkb.Worksheets(1)



    'Last row of header row information

    'set to 0 if no header row



    HeaderRow = 1



    'initializing the first row that the sorted data will be written to

    WriteRow = HeaderRow + 1



    'Finds the last used row

    With sht

        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then

            LastRow = .Cells.Find(What:="*", _

                          After:=.Range("A1"), _

                          Lookat:=xlPart, _

                          LookIn:=xlFormulas, _

                          SearchOrder:=xlByRows, _

                          SearchDirection:=xlPrevious, _

                          MatchCase:=False).Row

        Else

            LastRow = 1

        End If

    End With



    'Resize the array to match your data

    ReDim Arr(LastRow - HeaderRow, 4)



    'Copy the contents of the source data into an arr

    Arr() = Range(Cells(HeaderRow + 1, 1), Cells(LastRow, 4))



    'iterate through each row of the source data

    For counter1 = 1 To (LastRow - HeaderRow)

        'first row of data is potentially a special case

        If counter1 = 1 Then

            'Write out ID and Date

            For counter2 = 1 To 2

                Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)

            Next counter2

            'Write out Time in appropriate column

            If Arr(counter1, 4) = "I" Then

                Cells(WriteRow, 6 + 3) = Arr(counter1, 3)

            ElseIf Arr(counter1, 4) = "O" Then

                Cells(WriteRow, 6 + 4) = Arr(counter1, 3)

                WriteRow = WriteRow + 1

            End If

        'Check to see if ID changed

        ElseIf Arr(counter1 - 1, 1) = Arr(counter1, 1) Then

            'Check to see if Date has changed

            If Arr(counter1 - 1, 2) = Arr(counter1, 2) Then

                'Write out time in appropriate column

                If Arr(counter1, 4) = "I" Then

                    'Check if previous entry is a repeat

                    If Arr(counter1 - 1, 4) = Arr(counter1, 4) Then

                        'Advance Write a new line

                        WriteRow = WriteRow + 1

                    End If

                    For counter2 = 1 To 3

                        Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)

                    Next counter2

                ElseIf Arr(counter1, 4) = "O" Then

                    'Check if previous entry is a repeat

                    If Arr(counter1 - 1, 4) = Arr(counter1, 4) Then

                        'Write ID and Date

                        For counter2 = 1 To 2

                            Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)

                        Next counter2

                    End If

                    Cells(WriteRow, 6 + 4) = Arr(counter1, 3)

                    WriteRow = WriteRow + 1

                End If

            'What to do if date has changed

            Else

                If Arr(counter1 - 1, 4) = "I" Then

                    WriteRow = WriteRow + 1

                End If

                'Write ID and Date

                For counter2 = 1 To 2

                    Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)

                Next counter2

                'Write out Time in appropriate column

                If Arr(counter1, 4) = "I" Then

                    Cells(WriteRow, 6 + 3) = Arr(counter1, 3)

                ElseIf Arr(counter1, 4) = "O" Then

                    Cells(WriteRow, 6 + 4) = Arr(counter1, 3)

                    WriteRow = WriteRow + 1

                End If

            End If

            'What to do if ID has change

        Else

            If Arr(counter1 - 1, 4) = "I" Then

                WriteRow = WriteRow + 1

            End If

            'Write ID and Date

            For counter2 = 1 To 2

                Cells(WriteRow, 6 + counter2) = Arr(counter1, counter2)

            Next counter2

            'Write out Time in appropriate column

            If Arr(counter1, 4) = "I" Then

                Cells(WriteRow, 6 + 3) = Arr(counter1, 3)

            ElseIf Arr(counter1, 4) = "O" Then

                Cells(WriteRow, 6 + 4) = Arr(counter1, 3)

                WriteRow = WriteRow + 1

            End If

        End If

    Next counter1

End Sub