Excel Columns to Rows with a hitch

New Contributor

I have Sales Order Numbers in column A.  In column B are names of multiple people who work on the sales order and in column C are roles of the people who are listed in column B.  I need help to find a way by order number to move the names and roles of the people in columns B and C to a row with the sales order number still in column A.   Please see example below.  If there are any formulas or other techniques that you could suggest, that would be greatly appreciated!  


Existing Information in Columns/Rows    
Order #Resource AssignedResource Role    
5523John SmithSales Assistant    
5523Tammy BrownAccount Manager    
5523Felicia HuffPurchasing Agent    
4029Tammy BrownAccount Manager    
4029Felicia HuffPurchasing Agent    
4029Jason WilowskiSales Assistant    
3677Chris EricsonAccount Manager    
3677Bob WelshPurchasing Agent    
Desired Final View     
Order #Resource Assigned #1Resource #1 RoleResource Assigned #2Resource #2 RoleResource Assigned #3Resource #3 Role
5523John SmithSales AssistantTammy BrownAccount ManagerFelicia HuffPurchasing Agent
4029Tammy BrownAccount ManagerFelicia HuffPurchasing AgentJason WilowskiSales Assistant
3677Chris EricsonAccount ManagerBob WelshPurchasing Agent  




3 Replies


Here is a macro that you can run:


Sub Transform()
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim s As Long
    Dim m As Long
    Dim t As Long
    Dim c As Long
    Dim n As Long
    Application.ScreenUpdating = False
    Set w1 = ActiveSheet
    Set w2 = Worksheets.Add(After:=w1)
    w2.Cells(1, 1).Value = "Order #"
    t = 1
    m = w1.Cells(1, 1).End(xlDown).Row
    For s = 2 To m
        If w1.Cells(s, 1).Value <> w1.Cells(s - 1, 1).Value Then
            t = t + 1
            w2.Cells(t, 1).Value = w1.Cells(s, 1).Value
            c = 0
        End If
        c = c + 2
        If c > n Then n = c
        w2.Cells(t, c).Value = w1.Cells(s, 2).Value
        w2.Cells(t, c + 1).Value = w1.Cells(s, 3).Value
    Next s
    For c = 2 To n Step 2
        w2.Cells(1, c).Value = "Resource Assigned #" & c / 2
        w2.Cells(1, c + 1).Value = "Resource #" & c / 2 & " Role"
    Next c
    Application.ScreenUpdating = True
End Sub


An Excel 365 worksheet formula generating a single row of the output table:


where 'number'

= UNIQUE(Order)