Need macro excel to show data on change of heading

Deleted 

This version lets you specify the top left cell.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Change if you move the cell where you enter the code
    Const TopLeft = "D14"
    Dim wsh As Worksheet
    Dim cel As Range
    Dim tbl As Range
    Dim r As Long
    Dim c As Long
    Dim s As String
    Dim i As Long
    Dim r0 As Long
    Dim c0 As Long
    Dim m0 As Long
    Dim u As Long
    Dim d As Long
    Dim t As Long
    Dim users As New Collection
    Dim dates As New Collection
    
    Set cel = Range(TopLeft) 'Result
    If Not Intersect(cel, Target) Is Nothing Then
        ' Change name of worksheet with the data if needed
        Set wsh = Worksheets("Sheet1")
        c0 = 1
        Set tbl = wsh.Rows(2).Find(What:="User", LookAt:=xlWhole, MatchCase:=False)
        If tbl Is Nothing Then
            MsgBox "User column not found!", vbExclamation
            Exit Sub
        End If
        u = tbl.Column
        Set tbl = wsh.Rows(2).Find(What:="Date", LookAt:=xlWhole, MatchCase:=False)
        If tbl Is Nothing Then
            MsgBox "Date column not found!", vbExclamation
            Exit Sub
        End If
        d = tbl.Column
        Set tbl = wsh.Rows(2).Find(What:="Type", LookAt:=xlWhole, MatchCase:=False)
        If tbl Is Nothing Then
            MsgBox "Type column not found!", vbExclamation
            Exit Sub
        End If
        t = tbl.Column
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        With Intersect(cel.EntireRow, cel.CurrentRegion)
            .Interior.ColorIndex = xlColorIndexNone
            .Borders.LineStyle = xlLineStyleNone
        End With
        cel.CurrentRegion.Offset(1).Clear
        m0 = wsh.Cells(2, c0).End(xlDown).Row
        On Error Resume Next
        For r0 = 3 To m0
            If wsh.Cells(r0, c0).Value = cel.Value Then
                users.Add Item:=wsh.Cells(r0, u).Value, Key:=wsh.Cells(r0, u).Value
                dates.Add Item:=Int(wsh.Cells(r0, d).Value), Key:=CStr(Int(wsh.Cells(r0, d).Value))
            End If
        Next r0
        On Error GoTo 0
        SortCollection users
        For r = 1 To users.Count
            cel.Offset(r + 1, 0).Value = users(r)
        Next r
        SortCollection dates
        With cel.Resize(1, dates.Count + 1)
            .Interior.Color = RGB(0, 176, 80)
            .BorderAround LineStyle:=xlContinuous
        End With
        For c = 1 To dates.Count
            cel.Offset(1, c).Value = "Items"
            cel.Offset(users.Count + 2, c).Value = dates(c)
            If c Mod 2 Then
                cel.Offset(users.Count + 2, c).Interior.Color = RGB(197, 90, 17)
            Else
                cel.Offset(users.Count + 2, c).Interior.Color = RGB(61, 195, 176)
            End If
        Next c
        cel.Offset(2, 1).Resize(users.Count, dates.Count).Interior.Color = RGB(242, 242, 242)
        With cel.Offset(users.Count + 2).Resize(1, dates.Count + 1)
            .Font.Color = vbWhite
            .HorizontalAlignment = xlHAlignCenter
        End With
        For r = 1 To users.Count
            For c = 1 To dates.Count
                s = ""
                i = 0
                For r0 = 3 To m0
                    If wsh.Cells(r0, c0).Value = cel.Value And wsh.Cells(r0, u).Value = users(r) _
                            And Int(wsh.Cells(r0, d).Value) = dates(c) Then
                        i = i + 1
                        s = s & vbLf & i & ". " & wsh.Cells(r0, t).Value
                    End If
                Next r0
                If s <> "" Then
                    cel.Offset(r + 1, c).Value = Mid(s, 2)
                End If
            Next c
        Next r
        With cel.Offset(1).Resize(users.Count + 1, dates.Count + 1)
            .Borders.LineStyle = xlContinuous
            .VerticalAlignment = xlVAlignTop
        End With
        cel.Offset(1).Resize(1, dates.Count + 1).Interior.Color = RGB(255, 192, 0)
        With cel.Offset(users.Count + 2)
            .Value = "Date"
            .Interior.Color = RGB(0, 32, 96)
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub