Macro to help me transpose this information?

[suri tamna]

I searched for a similar situation to mine and didn't see one (apologies if one exists and I missed it!)

I have to format a long list of managers and their employees for mass emails, and the lists I get from our database are:


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Manager 1[/TD]
[TD]Employee A[/TD]
[/TR]
[TR]
[TD]Manager 2[/TD]
[TD]Employee B[/TD]
[/TR]
[TR]
[TD]Manager 2[/TD]
[TD]Employee C[/TD]
[/TR]
[TR]
[TD]Manager 2[/TD]
[TD]Employee D[/TD]
[/TR]
[TR]
[TD]Manager 3[/TD]
[TD]Employee E[/TD]
[/TR]
[TR]
[TD]Manager 3[/TD]
[TD]Employee F[/TD]
[/TR]
[TR]
[TD]Manager 4[/TD]
[TD]Employee G[/TD]
[/TR]
[TR]
[TD]Manager 4[/TD]
[TD]Employee H[/TD]
[/TR]
</tbody>[/TABLE]

But I need the data to be formatted like this:

[TABLE="class: grid, width: 700"]
<tbody>[TR]
[TD]Manager 1[/TD]
[TD]Employee A[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Manager 2[/TD]
[TD]Employee B[/TD]
[TD]Employee C[/TD]
[TD]Employee D[/TD]
[/TR]
[TR]
[TD]Manager 3[/TD]
[TD]Employee E[/TD]
[TD]Employee F[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Manager 4[/TD]
[TD]Employee G[/TD]
[TD]Employee H[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


So, I'd like to sort all employees who report to the same manager so that they appear on the row next to that manager rather than in a column with the manager's name listed as many times as there are employees reporting to that manager. I sometimes have situations where there are 20 people reporting to a manager, and I have thousands of records to transpose, so doing this manually is a real bummer.

Thank you in advance to any solutions, and let me know if I can clarify anything.

 

[Peter_SSs]

Welcome to the MrExcel board!

If the list is in columns A:B starting at row 2 and results can go in columns D, E, F, ... then give this a try in a copy of your workbook.

Sub Rearrange()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    d(a(i, 1)) = d(a(i, 1)) & "," & a(i, 2)
  Next i
  With Range("D2:E2").Resize(d.Count)
    .Value = Application.Transpose(Array(d.Keys, d.Items))
    .Columns(2).TextToColumns DataType:=xlDelimited, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9))
    .CurrentRegion.Columns.AutoFit
  End With
End Sub