Sorting export Data

Add sheet named "Sheet2" if not in the workbook.

Sub test()
    Dim a, i As Long, ii As Long, n As Long, AL As Object
    Dim myDate As Date
    Set AL = CreateObject("System.Collections.ArrayList")
    If Not [isref('sheet2'!a1)] Then Sheets.Add.Name = "Sheet2"
    With Sheets("sheet1")
        a = .Range("b2", .Cells.SpecialCells(11)).Value
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            If a(i, 1) = "Employee" Then
                For ii = 2 To UBound(a, 2)
                    If a(i, ii) Like "*##/##/####" Then
                        a(i, ii) = Replace(a(i, ii), vbLf, "")
                        a(i, ii) = DateSerial(Val(Right$(a(i, ii), 4)), _
                        Val(Mid$(a(i, ii), 7, 2)), Val(Mid$(a(i, ii), 4, 2)))
                    End If
                Next
                n = i
            Else
                If a(i, 1) <> "" Then
                    If Not .exists(a(i, 1)) Then
                        Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
                    End If
                    For ii = 2 To UBound(a, 2)
                        If IsDate(a(n, ii)) Then
                            If Not AL.Contains(a(n, ii)) Then AL.Add a(n, ii)
                            .Item(a(i, 1))(a(n, ii)) = a(i, ii)
                        End If
                    Next
                End If
            End If
        Next
        ReDim a(1 To .Count + 2, 1 To AL.Count + 1): AL.Sort
        For ii = 0 To AL.Count - 1
            a(1, ii + 2) = AL(ii): a(2, ii + 2) = AL(ii)
        Next
        For i = 0 To .Count - 1
            a(i + 3, 1) = .keys()(i)
            For ii = 2 To UBound(a, 2)
                a(i + 3, ii) = .items()(i)(a(1, ii))
            Next
        Next
    End With
    With Sheets("sheet2").[b1].Resize(UBound(a, 1), UBound(a, 2))
        .Parent.Cells.Clear
        .Value = a
        .Offset(, 1).Resize(2, .Columns.Count - 1).BorderAround Weight:=2
        .Rows(1).NumberFormat = "yyyy/m/d"
        .Rows(2).NumberFormat = "ddd""""dd/mm/yyyy"
        .Columns(1).Offset(2).Resize(.Rows.Count - 2).Borders.Weight = 2
        .WrapText = False
        .Columns.AutoFit
        .Rows.AutoFit
        .Offset(, 1).HorizontalAlignment = xlCenter
        With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1)
            .Borders(11).LineStyle = xlDot
            .Borders(12).Weight = 2
            .BorderAround Weight:=2
        End With
        For ii = 2 To .Columns.Count Step 7
            .Columns(ii).Borders(7).LineStyle = 1
        Next
    End With
End Sub

Hi Again.

That is great and is working Fantastically. I have just noticed that some people have 2 lines of data. This is due to the way the information is exported by the systems (which can not be changed). is there a way of amending the VBA so that it does one of the 2 options below:

1. Only pulls out the pay codes for example "Hol 8:00, .Ho 4:00, Dec 8:00" and so on

2. Populate 2 worksheets with the lines of data. in worksheet one you would have the full day scheduled events in the second sheet you would have the partial/additional scheduled events.

I know that the above is a little confusing so if you have any questions or require a sample of data please let me know

Thank you again for all of the support with this it really is appreciated!

Thanks

D