VBA for the data in post #3
Sub test()
    Dim a, i As Long, ub As Long, w, maxCol As Long
    With Range("a1").CurrentRegion.Resize(, 4)
        a = .Value: ub = UBound(a, 2)
        With CreateObject("Scripting.Dictionary")
            For i = 2 To UBound(a, 1)
                If a(i, 1) = "Y" Then
                    If Not .exists(a(i, 2)) Then
                        ReDim w(1 To 2)
                        w(1) = i: w(2) = ub - 1
                    Else
                        w = .Item(a(i, 2))
                    End If
                    w(2) = w(2) + 1: .Item(a(i, 2)) = w
                    If UBound(a, 2) < w(2) Then ReDim Preserve a(1 To UBound(a, 1), 1 To w(2))
                    a(w(1), w(2)) = a(i, ub)
                    maxCol = Application.Max(maxCol, w(2))
                End If
            Next
        End With
        .Resize(, maxCol).Value = a
    End With
End Sub