concatenating some data from multiple rows into multiple columns based on a unique no.

I have a very large file (94000 rows) with 3 columns. It is very difficult to explain so I have attached a sample with a small section of those 3 columns on the left, and what I am trying to achieve on the right.

Basically the end result needs to show the ID number only once per row, with the party names concatenated together under the various interest types. I have 11400 ID's but currently they are being duplicated each time there is a different party name and/or interest type, so I am trying to get the file down to 11400 lines but retain the party name and interest type information by concatenating them.

For example in the original list there are 2 freeholders and 3 leaseholders for ID LP00004. I need to concatenate the 2 freeholders into a freehold column, and the leaseholders into a leasehold column so that the end result is one row per ID number, but still containing all of the information in the original list.

This has been done before with this data but I am no longer in touch with the person that did it and have no idea how it was done. I suspect they might have used several pivot tables to manipulate the data and then cut and paste them but I haven't been able to work out what they did. I do know that sometimes the number of party names was so long it would not fit into a single cell and got cut off (which again leads me to believe it might have been done via some pivot tables rather than a macro which might fall over if the text won't fit in the cell?).

Anyone know how to do this? I don't mind whether it is via a macro or pivot tables, I am using excel 2013.

Thanks

Try this in your Data sheet, for results starting "F1".

Sub MG30May43
Dim Ray         As Variant
Dim n           As Long
Dim Dic         As Object
Dim Q           As Variant
Dim col         As Integer
Ray = ActiveSheet.Range("A1").CurrentRegion.Resize(, 3)
 Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   For n = 2 To UBound(Ray, 1)
          Select Case Ray(n, 2)
            Case "Freehold": col = 2
            Case "Leasehold": col = 3
            Case "Occupier": col = 4
            Case "Unknown": col = 5
        End Select
        If Not Dic.exists(Ray(n, 3)) Then
                Set Dic(Ray(n, 3)) = CreateObject("Scripting.Dictionary")
            End If
        If Not Dic(Ray(n, 3)).exists(Ray(n, 2)) Then
            Dic(Ray(n, 3)).Add (Ray(n, 2)), Array(Ray(n, 1), col)
        Else
            Q = Dic(Ray(n, 3)).Item(Ray(n, 2))
                Q(0) = Q(0) & "," & Ray(n, 1)
            Dic(Ray(n, 3)).Item(Ray(n, 2)) = Q
        End If
    Next n
Dim k As Variant
Dim p As Variant, c As Long
ReDim nray(1 To UBound(Ray, 1), 1 To 5)
nray(1, 1) = "ID number": nray(1, 2) = "Freehold": nray(1, 3) = "Leasehold": nray(1, 4) = "Occupier": nray(1, 5) = "Unknown"
 c = 1
For Each k In Dic.Keys
        c = c + 1
        For Each p In Dic(k)
               nray(c, 1) = k
               nray(c, Dic(k).Item(p)(1)) = Dic(k).Item(p)(0)
            Next p
Next k

With Range("F1").Resize(c, 5)
    .Value = nray
    .Borders.Weight = 2
     .Columns.AutoFit
End With
End Sub

Regards Mick