0

I have this:

badly formatted table

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

I want to transform it like this:

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

4
  • Possible duplicate of How to combine values from multiple rows into a single row in Excel? – Scott Nov 19 '18 at 3:27
  • Create a pivot, use employee number and date as the rows, and min and max of time for time as the values for time in and time – PeterH Nov 19 '18 at 14:33
  • can there be multiple ins on the same date? Conversely multiple outs on the same date? – Forward Ed Nov 20 '18 at 4:44
  • @ForwardEd, yes and there can also be no In time for a certain date but has a OUT time – NoobPro Nov 21 '18 at 5:33
0

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

Pivot

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

format

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

tabular

Also turning off the display of Subtotals & Grand Totals:

subtotals

grandtotals

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).

1
  • Hey it works, but i need the result to be editable. Sorry saying it just now, I've edited my post – NoobPro Nov 20 '18 at 1:44
0

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

enter image description here

1
  • Hey it works, but the I's and O's in the first table arent necessarily alternating. Sorry saying it just now, I've edited my post – NoobPro Nov 20 '18 at 1:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.