DanniiMarie

New Member
Joined
May 21, 2018
Messages
24
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
Nance Broadbury

<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 you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

DanniiMarie

New Member
Joined
May 21, 2018
Messages
24
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
Joined
Jul 23, 2007
Messages
4,755
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
                objMyUniqueData.Add CStr(rngMyCell), rngMyCell
                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
Joined
May 21, 2018
Messages
24
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
Joined
Jun 12, 2014
Messages
59,927
Office Version
  1. 365
Platform
  1. Windows
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
         Dic.Add v1, CreateObject("scripting.dictionary")
         Dic(v1).Add v2, Nothing
      ElseIf Not Dic(v1).exists(v2) Then
         Dic(v1).Add v2, Nothing
      End If
   Next cl
   For Each Ky In Dic.keys
      For Each k In Dic(Ky).keys
         Lst.Add k
      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
 

Forum statistics

Threads
1,136,339
Messages
5,675,193
Members
419,553
Latest member
hanahass

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top