# Consolidation

#### DanniiMarie

##### New Member
I have a list of employees and their manager's names. I need to consolidate the list so each manager name appears only once in column A and each employee is in a column to the right of the manager name. Ideally, the employees' names would be alphabetized from left to right, as well.

Here is a sample raw data set:

 Manager Name Employee Name Cort Haslock April MacGeffen Augusto Lampett Averill Colbran Leta Bilson Betteanne Christescu Benni Lait Bonnee Plaunch Leta Bilson Catarina Francescozzi Cort Haslock Clive Corain Leta Bilson Dory Fayne Joana Imeson Josy Jereatt Cort Haslock Marcelo Dumsday Joana Imeson Nance Broadbury Leta Bilson Quint Minette Benni Lait Rosabel Bourdis Leta Bilson Stefania Shute Moll Branscombe Tine Cardello Cort Haslock Trueman Poolton Joana Imeson Vanny Jell Moll Branscombe Zarla Melmore

<tbody>
</tbody>

Here is what I'd like the final data set to look like:
Manager NameEmployee1Employee2Employee3Employee4Employee5
Benni Lait
 Bonnee Plaunch

<tbody>
</tbody>
 Rosabel Bourdis

<tbody>
</tbody>
 Leta Bilson

<tbody>
</tbody>
 Betteanne Christescu

<tbody>
</tbody>
Catarina FrancescozziDory FayneQuint MinetteStefania Shute
 Joana Imeson

<tbody>
</tbody>
Josy Jereatt

<tbody>
</tbody>
Vanny Jell
Augusto LampettAverill Colbran
Cort HaslockApril MacGeffenClive CorainMarcelo DumsdayTrueman Poolton
Moll BranscombeTine CardelloZarla Melmore

<tbody>
</tbody>

I get a different data set like this each week and I'd like a less manual method to accomplish this task than what I've been using. Thanks!

### Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

#### DanniiMarie

##### New Member
Re: Consolidateion

**Disregard the extra boxes around the two names. That's just a cut and paste issue! LOL! Thanks again!

#### Trebor76

##### Well-known Member
Re: Consolidateion

Hi DanniiMarie,

Welcome to MrExcel!!

This macro will do the job:

Code:
``````Option Explicit
Sub Macro1()

Dim lngLastRow As Long
Dim lngPasteRow As Long
Dim lngOffsetCol As Long
Dim lngMyRow As Long
Dim rngMyCell As Range
Dim objMyUniqueData As Object

Application.ScreenUpdating = False

lngLastRow = Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Assumes names are in column A and B. Change to suit.

Set objMyUniqueData = CreateObject("Scripting.Dictionary")

'List out each unique manager's name and their associated employees
For Each rngMyCell In Range("A2:A" & lngLastRow) 'Assumes Manager's names are in column A from row 2. Change to suit if necessary.
If Len(rngMyCell) > 0 Then
If objMyUniqueData.Exists(CStr(rngMyCell)) = False Then
If lngPasteRow = 0 Then
lngPasteRow = 2
Else
lngPasteRow = lngPasteRow + 1
End If
lngOffsetCol = 0
Range("C" & lngPasteRow).Offset(0, lngOffsetCol) = rngMyCell 'Output unique Manager's name into column C. Change to suit if necessary.
For lngMyRow = 2 To lngLastRow
If Range("A" & lngMyRow) = rngMyCell Then
lngOffsetCol = lngOffsetCol + 1
Range("C" & lngPasteRow).Offset(0, lngOffsetCol) = Range("B" & lngMyRow)
End If
Next lngMyRow
End If
End If
Next rngMyCell

Set objMyUniqueData = Nothing

Application.ScreenUpdating = True

End Sub``````

Regards,

Robert

#### DanniiMarie

##### New Member
Re: Consolidateion

This macro did everything but alphabetize the employees left to right. Even without the alphabetizing, this is a HUGE help!!!!

#### Fluff

##### MrExcel MVP, Moderator
Re: Consolidateion

Here's another option, that will sort the employee's
Code:
``````Sub getEmps()
Dim cl As Range
Dim Dic As Object
Dim v1 As String, v2 As String
Dim Ky As Variant, k As Variant
Dim Lst As Object, itm As Variant
Dim c As Long

Set Lst = CreateObject("System.Collections.ArrayList")
Set Dic = CreateObject("scripting.dictionary")
For Each cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
v1 = cl.value: v2 = cl.Offset(, 1).value
If Not Dic.exists(v1) Then
ElseIf Not Dic(v1).exists(v2) Then
End If
Next cl
For Each Ky In Dic.keys
For Each k In Dic(Ky).keys
Next k
Lst.Sort
With Sheets("New").Range("A" & Rows.Count).End(xlUp)
.Offset(1).value = Ky
.Offset(1, 1).Resize(, Lst.Count).value = Lst.toarray
Lst.Clear
End With
Next Ky
End Sub``````

1,171,828
Messages
5,877,785
Members
433,287
Latest member
amna_shahbaz

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back