How to Merge multiple duplicate rows into columns

Hi there this is a repost of my problem last night since my first post was wrongly done... anyhow here's my problem:

i have this data that have lots of duplicate rows wherein they are the date a certain employee have had his time punch what i want to accomplish is that each date would be having only one row of 2 punch_in and 2 punch out.

here's my workbook: for testing.xlsm

simply put i want my the data in my rawdata sheet to appear like the one i have in sheet1

also i found a working code here though it yields an almost similar result though its not the one that i needed

here's the code:

Sub x()

Dim rInput As Range, oDic As Object, sNames() As String, vInput()
Dim i As Long, nIndex As Long

Set rInput = Range("A1", Range("B65536").End(xlUp))
vInput = rInput.Value
ReDim sNames(1 To UBound(vInput, 1), 1 To 2)
Set oDic = CreateObject("Scripting.Dictionary")

With oDic
    For i = 1 To UBound(vInput, 1)
        If Not .Exists(vInput(i, 1)) Then
            nIndex = nIndex + 1
            sNames(nIndex, 1) = vInput(i, 1)
            sNames(nIndex, 2) = vInput(i, 2)
            .Add vInput(i, 1), nIndex
        ElseIf .Exists(vInput(i, 1)) Then
            sNames(.Item(vInput(i, 1)), 2) = sNames(.Item(vInput(i, 1)), 2) & ", " & vInput(i, 2)
        End If
    Next i
End With

Cells(1, "H").Resize(nIndex, 2) = sNames
' The line below if you want the words in separate columns
' otherwise they are in a single cell, separated by commas
Cells(1, "I").Resize(nIndex).TextToColumns , comma:=True

End Sub

thank you in advance for your help

That seems a little complex for something that simple worksheet formulas can accomplish. Delete your sheet1 so your RawData is the only sheet, then try this:

Option Explicit

Sub ReformatData()
Dim LR As Long, BR As Long, RawSht As Worksheet

If MsgBox("Process active sheet?", vbYesNo, "Confirm") = vbNo Then Exit Sub

Application.ScreenUpdating = False
Set RawSht = ActiveSheet
LR = RawSht.Range("A" & Rows.Count).End(xlUp).Row
Sheets.Add
RawSht.Range("A1:A" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True
Range("B1:E1").Value = [{"IN_Normal","Out_Lunch","In_Lunch","Out_Normal"}]
Range("A:E").EntireColumn.AutoFit
BR = Range("A" & Rows.Count).End(xlUp).Row

Range("B2:B" & BR).Formula = "=INDEX('" & RawSht.Name & "'!B:B, MATCH($A2, '" & RawSht.Name & "'!$A:$A, 0))"
Range("C2:C" & BR).Formula = "=INDEX('" & RawSht.Name & "'!D:D, MATCH($A2, '" & RawSht.Name & "'!$A:$A, 0))"
Range("D2:D" & BR).Formula = "=INDEX('" & RawSht.Name & "'!B:B, MATCH($A2, '" & RawSht.Name & "'!$A:$A, 0)+1)"
Range("E2:E" & BR).Formula = "=INDEX('" & RawSht.Name & "'!B:B, MATCH($A2, '" & RawSht.Name & "'!$A:$A, 0)+1)"

With Range("B2:E" & BR)
    .Value = .Value
    .NumberFormat = "h:mm;@"
End With

Application.ScreenUpdating = True
End Sub

Option Explicit

Sub ReformatData()
Dim LR As Long, BR As Long, RawSht As Worksheet

If MsgBox("Process active sheet?", vbYesNo, "Confirm") = vbNo Then Exit Sub

Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True
Range("I1:L1").Value = [{"IN_Normal","Out_Lunch","In_Lunch","Out_Normal"}]
Range("H:L").EntireColumn.AutoFit
BR = Range("H" & Rows.Count).End(xlUp).Row

Range("I2:I" & BR).Formula = "=INDEX(B:B, MATCH($A2, $A:$A, 0))"
Range("J2:J" & BR).Formula = "=INDEX(D:D, MATCH($A2, $A:$A, 0))"
Range("K2:K" & BR).Formula = "=INDEX(B:B, MATCH($A2, $A:$A, 0)+1)"
Range("L2:L" & BR).Formula = "=INDEX(D:D, MATCH($A2, $A:$A, 0)+1)"

With Range("I2:L" & BR)
    .Value = .Value
    .NumberFormat = "h:mm;@"
End With

Application.ScreenUpdating = True
End Sub

Please post your question in a new thread of its own. Please read the Forum Rules we all abide (link above in the menu bar).

Thanks.