• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Arrange Multiple rows into columns

rumshar

Member
Hi All,
  • I am attaching two files herewith. One is input(Providers List) and another one is output.
    I would like to have one line per provider and see the different payers listed out in each column with the corresponding ID next to them. Kindly see the output file for my requirement.
  • Thanks for reading this and tonnes of help for helping with beautiful code.
Regards
Rudra
 

Attachments

  • Out Put.xls
    26 KB · Views: 0
  • Providers List.xlsx
    322.1 KB · Views: 0
Hello,
Add your sheet called "Output" in your Provider List file, then run this code :

Code:
Sub CompileData()
    Dim Dict
    Dim ar, a, b, c
    Dim i As Long, j As Long
    Dim sFullName As String

    ar = Sheets("Data").Cells(1).CurrentRegion.Value

    Set Dict = CreateObject("scripting.dictionary")
   
    'Create a dictionary of unique Fullnames
    'For each fullname store info and payer1-n info
    For i = 2 To UBound(ar, 1)
        sFullName = ar(i, 5) & " " & ar(i, 4)
        If Not Dict.exists(sFullName) Then
            Dict(sFullName) = ar(i, 6) & Chr(2) & ar(i, 7) & Chr(2) & ar(i, 8) & Chr(2) & ar(i, 9) & _
                              Chr(2) & ar(i, 12) & Chr(2) & ar(i, 13)
        Else
            Dict(sFullName) = Dict(sFullName) & Chr(2) & ar(i, 12) & Chr(2) & ar(i, 13)
        End If

    Next i

    'Output results
    a = Dict.keys
    b = Dict.items
    With Sheets("Output")
        For i = 0 To Dict.Count - 1
            .Cells(i + 2, 1) = a(i)
            c = Split(b(i), Chr(2))
            .Cells(i + 2, 2).Resize(1, UBound(c)) = c
        Next i
    End With

End Sub
 
Back
Top