Looping Through Worksheet Finding Matching Data

Hello, I stuck on this problem, I have included a sample worksheet of what my data looks like (tab1)and what I would like the data to look like(tab2) tab 3 is just a reset in case the script messes up the data.

What I am trying to do is look at col A and B and if those same values are found later on down the list and the date is not the same as the one found, move the found time into the same col and row and delete the found values from col a , col b and the start time and stop time.

It is difficult to explain is why I included a spreadsheet to help. Here is the script I'm working with. It appears to work till a duplicate isn't found then it starts to mess up.

Thanks for any help, Mike

With sheets(1)
LROW = .Cells(Rows.Count, 1).End(xlUp).Row
            For r = LROW To 6 Step -1
                For c = 3 To 15 Step 2
                            If .Cells(r, c) <> vbNullString Then
                                For r2 = 6 To LROW
                                    If .Cells(r2, 1) = .Cells(r, 1) And .Cells(r2, 2) = .Cells(r, 2) And r <> r2 And .Cells(r2, c) = vbNullString Then
                                        .Cells(r2, c) = .Cells(r, c)
                                        .Cells(r2, c).NumberFormat = "[$-409]h:mm AM/PM;@"
                                        .Cells(r2, c + 1) = .Cells(r, c + 1)
                                        .Cells(r2, c + 1).NumberFormat = "[$-409]h:mm AM/PM;@"
                                        .Cells(r, c) = ""
                                        .Cells(r, c + 1) = ""
                                        .Cells(r, 1) = ""
                                        .Cells(r, 2) = ""
                                        GoTo 10
                                    End If
                                Next r2
                            End If
                Next c
10
            Next r
end with

Try this...

Sub Rest_Data()
    'Reset data for testing
    Sheets(1).Range("A7:P16").Value = Sheets(3).Range("A7:P16").Value
End Sub


Sub RNG()
    
    Dim v As Variant, r As Long, r2 As Long, c As Long
        
    With Sheets(1)
    
        v = .Range("A7:P" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
        
        For r = 1 To UBound(v, 1) - 1
            If v(r, 1) <> "" Then
                For r2 = r + 1 To UBound(v, 1)
                    If v(r2, 1) = v(r, 1) And v(r2, 2) = v(r, 2) Then
                    
                        For c = 3 To UBound(v, 2) Step 2
                                
                            If v(r2, c) <> "" And v(r, c) = "" Then
                                
                                v(r, c) = v(r2, c)
                                v(r, c + 1) = v(r2, c + 1)
                                
                                v(r2, 1) = ""
                                v(r2, 2) = ""
                                v(r2, c) = ""
                                v(r2, c + 1) = ""
                                
                                Exit For
                                
                            End If
                        Next c
                    End If
                Next r2
            End If
        Next r
        
        '.Unprotect "tomcat9765"
        Application.ScreenUpdating = False
        .Range("A7:P" & .Cells(Rows.Count, 1).End(xlUp).Row).Value = v
        .Range("C7:P" & .Cells(Rows.Count, 1).End(xlUp).Row).NumberFormat = "[$-409]h:mm AM/PM;@"
        With .Range("A7", .Cells(Rows.Count, 1).End(xlUp))
            If Application.CountBlank(.Cells) Then .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With
        Application.ScreenUpdating = True
        '.Protect "tomcat9765"
        
    End With
End Sub

You're welcome. Thanks for the feedback.