I was recently asked by a my friend Joe to help him with an Excel problem. He wanted to convert data in a vertical list into a horizontal list. This sort of thing is one of those things which is usually done with a pivot table. What if your data is a unique ID and clients which can be attached to the same unique id.
Original
| ID | Company |
|---|---|
| 001 | Company A |
| 001 | Company A |
| 002 | Company B |
| 003 | Company D |
| 003 | Company E |
| 003 | Company F |
Result
| ID | Client 1 | Client 2 | Client 3 |
|---|---|---|---|
| 001 | Company A | Company A | |
| 002 | Company B | ||
| 001 | Company D | Company E | Company F |
To do this you could take a number of approaches. The one I would choose would be to use the scripting dictionary to trap the unique ids and assign companies to those IDs horizontally. This requires that the size of the array where the data is stored needs to be flexible.
Option Explicit
Sub CreateHorizontal() 'VBA to convert a verticle range into a horizontal range sorted by UID.
Dim dic As Object
Dim ar As Variant
Dim var As Variant
Dim r As Range
Dim i As Integer
Set dic = CreateObject("Scripting.Dictionary") 'Create Storage (dict)
With Sheet1
For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
If Not IsEmpty(r) Then
If Not dic.exists(r.Value) Then
ReDim ar(1)
ar(0) = r.Value: ar(1) = r.Offset(, 1).Value
dic.Add r.Value, ar
Else
ar = dic(r.Value)
ReDim Preserve ar(UBound(ar) + 1)
ar(UBound(ar)) = r.Offset(, 1).Value
dic(r.Value) = ar
End If
End If
Next
End With
var = dic.items: Set dic = Nothing
With Sheet3.Range("A2") 'Store the result
.CurrentRegion.Offset(1).ClearContents
For i = 0 To UBound(var)
.Offset(i).Resize(, UBound(var(i)) + 1) = var(i)
Next
End With
End Sub
The Excel file to achieve this task with the scripting dictionary is attached. The opposite of this can also be done and the approach is outlined in the following artical Horizontal to Vertical Range in Excel.
