Need VBA Macro to Consolidate data

[jbaillie]

I have attached a spreadsheet with example of data I am trying to consolidate. This spreadsheet will be used to request records from provider offices.

In Colum B and C contain Clients name. But you can see in Column at they may have more than one value being requested from provider office in column F thru N.

The original sheet contains over 5,000 lines.

I need a Macro that will consolidate the data in column "A" if the client is listed more than once and request is going to the same provider office.

I have highlighted on the sheet where the duplicates are at . I need to have the sheet consolidate that data.

Any help you could give would be greatly appreciated. This macro will save me 1 to 2 days of work.

Thank you,
Judy

[jbaillie]

Typo: But you can see in Column "A" they may have more than one value being requested from provider office in column F thru N

[beyond Excel]

.
Hi jbaillie.

Upload your workbook to the Forum again but -this time- you must include a second sheet in which you will show us what the expected final result is.

[jbaillie]

I have attached spread sheet on how the data should look after the Macro runs.

Thank you,
Judy

[bebo021999]

Try this:

Option Explicit
Sub consolidate()
Dim lr&, i&, j&, k&, rng, id As String, arr(1 To 10000, 1 To 14)
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
    lr = .Cells(Rows.Count, "D").End(xlUp).Row
    rng = .Range("A2:N" & lr).Value
    For i = 1 To UBound(rng)
        id = rng(i, 4) & "|" & rng(i, 6) & "|" & rng(i, 7)
        If Not dic.exists(id) Then
            dic.Add id, rng(i, 1)
            k = k + 1
            For j = 1 To 14
                arr(k, j) = rng(i, j)
            Next
        Else
            dic(id) = dic(id) & ";" & rng(i, 1)
            For j = 1 To k
                If arr(j, 4) & "|" & arr(j, 6) & "|" & arr(j, 7) = id Then arr(j, 1) = dic(id)
            Next
        End If
    Next
    .Range("A2:N10000").ClearContents
    .Range("A2").Resize(dic.Count, 14).Value = arr
End With
End Sub 

[jbaillie]

I get Run-time error '9':
Subscript out of range

It shows the error highlighted in yellow in attachment. How do I fix?
Thank you,

[bebo021999]

Make sure you have sheet name "Sheet1"
This is the working file.