How to convert a list to a table by a single field

pjingle

New Member
Joined
Oct 16, 2014
Messages
1
Hope someone can help. I have a list of data as follows
EmployeeProject
AMEYV 32710-NDIA-1000
AMEYV 32687-POST-1000
AMEYV 32710-NDIA-1000
AMEYV 32710-NDIA-1000
BRADYS 32708-CDGP-1000
BRADYS 32723-FSRP-1000
BRADYS 32723-FSRP-1000
BRADYS 32723-FSRP-1000
CANDLINT 32666-DMOS-1000
CANDLINT 32666-DMOS-1000
CANDLINT 32666-DMOS-1000
COLEC QES5283-3223
COLEC QES5283-4206
COLEC QES5429-4000
COLEC QES5283-4206
COLEC QES5283-4206
COLEC QES5283-4206
DAVIESCL 32724-FSRP-1000
DAVIESCL 32724-FSRP-1000
<colgroup><col width="100" style="width: 75pt; mso-width-source: userset; mso-width-alt: 3657;"> <col width="155" style="width: 116pt; mso-width-source: userset; mso-width-alt: 5668;"> <tbody> </tbody>

and I want to create the following table

EmployeeProject
AMEYV 32710-NDIA-100032687-POST-1000
BRADYS 32708-CDGP-100032723-FSRP-1000
CANDLINT 32666-DMOS-1000
COLEC QES5283-3223 QES5283-4206 QES5429-4000 QES5283-4206
DAVIESCL 32724-FSRP-1000
<colgroup><col width="78" style="width: 59pt; mso-width-source: userset; mso-width-alt: 2852;"> <col width="118" style="width: 89pt; mso-width-source: userset; mso-width-alt: 4315;"> <col width="114" style="width: 86pt; mso-width-source: userset; mso-width-alt: 4169;"> <col width="108" style="width: 81pt; mso-width-source: userset; mso-width-alt: 3949;" span="2"> <tbody> </tbody>

can this be done automatically as the data set is over 10,000 lines?
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
maybe something like...

the formula in D2 would give you a unique list of Employee names. the formula in E2 dragged right and down until you get blanks.

Both formulas are arrays and need to be entered with control shift enter.

there are alternate ways to get the unique list of employees you might want to consider.

Excel 2012
ABCDEFG
1EmployeeProjectEmployeeProject
2AMEYV32710-NDIA-1000AMEYV32710-NDIA-100032687-POST-1000
3AMEYV32687-POST-1000BRADYS32708-CDGP-100032723-FSRP-1000
4AMEYV32710-NDIA-1000CANDLINT32666-DMOS-1000
5AMEYV32710-NDIA-1000COLECQES5283-3223QES5283-4206QES5429-4000
6BRADYS32708-CDGP-1000DAVIESCL32724-FSRP-1000
7BRADYS32723-FSRP-1000
8BRADYS32723-FSRP-1000
9BRADYS32723-FSRP-1000
10CANDLINT32666-DMOS-1000
11CANDLINT32666-DMOS-1000
12CANDLINT32666-DMOS-1000
13COLECQES5283-3223
14COLECQES5283-4206
15COLECQES5429-4000
16COLECQES5283-4206
17COLECQES5283-4206
18COLECQES5283-4206
19DAVIESCL32724-FSRP-1000
20DAVIESCL32724-FSRP-1000

<tbody>
</tbody>
Sheet3

Array Formulas
CellFormula
D2{=IFERROR(INDEX($A$2:$A$20,SMALL(IF(FREQUENCY(IF($A$2:$A$20<>"",MATCH($A$2:$A$20,$A$2:$A$20,0)),ROW($A$2:$A$20)-ROW($A$2)+1),ROW($A$2:$A$20)-ROW($A$2)+1),ROWS($D$2:D2))),"")}
E2{=IFERROR(INDEX($B$2:$B$20,SMALL(IF(FREQUENCY(IF($A$2:$A$20<>"",IF($A$2:$A$20=$D2,MATCH($B$2:$B$20,$B$2:$B$20,0))),ROW($B$2:$B$20)-ROW($B$2)+1),ROW($B$2:$B$20)-ROW($B$2)+1),COLUMNS($E2:E2))),"")}
F2{=IFERROR(INDEX($B$2:$B$20,SMALL(IF(FREQUENCY(IF($A$2:$A$20<>"",IF($A$2:$A$20=$D2,MATCH($B$2:$B$20,$B$2:$B$20,0))),ROW($B$2:$B$20)-ROW($B$2)+1),ROW($B$2:$B$20)-ROW($B$2)+1),COLUMNS($E2:F2))),"")}
G2{=IFERROR(INDEX($B$2:$B$20,SMALL(IF(FREQUENCY(IF($A$2:$A$20<>"",IF($A$2:$A$20=$D2,MATCH($B$2:$B$20,$B$2:$B$20,0))),ROW($B$2:$B$20)-ROW($B$2)+1),ROW($B$2:$B$20)-ROW($B$2)+1),COLUMNS($E2:G2))),"")}

<tbody>
</tbody>
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
Note: Do not try and enter the {} manually yourself

<tbody>
</tbody>
 
Upvote 0
Here is another solution using VBA.

Code:
Sub test()
    Dim shData As Worksheet, shRes As Worksheet
    Dim rEmployee As Range, rProject As Range
    Dim i As Long, x As Long, y As Long
    
    Application.ScreenUpdating = False
    Set shData = ActiveSheet: Set shRes = Sheets.Add
    x = Cells.Rows.Count: y = Cells.Columns.Count
    
    For i = 1 To shData.Cells(x, 1).End(xlUp).Row
        Set rEmployee = _
            shRes.Columns(1).Find(shData.Cells(i, 1).Value, SearchOrder:=xlByRows)
        If rEmployee Is Nothing Then
            Set rEmployee = shRes.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1)
            rEmployee.Value = shData.Cells(i, 1).Value
        End If
        Set rProject = rEmployee.EntireRow.Find(shData.Cells(i, 2).Value, SearchOrder:=xlByColumns)
            If rProject Is Nothing Then
                shRes.Cells(rEmployee.Row, y).End(xlToLeft).Offset(, 1).Value = _
                shData.Cells(i, 2).Value
            End If
    Next
    shRes.Rows(1).Delete
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub
 
Upvote 0
Hi Colo,
Being relatively new at VBA, where in the code, does it point to the data being in column A,B and the output starting in column D.
Thanks
 
Upvote 0
Hi Colo,
Sorry to be a pest, but I need some more assistance with your code.
It does work like charm!!

a. If the data resides in Sheet1 and I desire the out in Sheet2, where would I make these changes to the code?
b. Where in the code would I specify the input columns from Sheet1 and specify the starting output column in Sheet2.

Many thanks
 
Upvote 0
Hi jumpulas,

I wrote some advices in the following code line.
Please have a look at those and give it a try.

Code:
Sub test2()
    Dim shData As Worksheet, shRes As Worksheet
    Dim rEmployee As Range, rProject As Range
    Dim i As Long, x As Long, y As Long
    
    Application.ScreenUpdating = False
    
    'Answer for Qtn a) Change here for changing worksheets' name
    Set shData = Sheets("Sheet1"): Set shRes = Sheets("Sheet2")
    x = Cells.Rows.Count: y = Cells.Columns.Count
    
    shRes.Cells.Clear 'added this line for reset the result
    
    
    'Answer for Qtn b) I changed using Numbers to Letters for columns so that you can change those.
    '
    For i = 1 To shData.Cells(x, 1).End(xlUp).Row
        Set rEmployee = _
            shRes.Columns(1).Find(shData.Cells(i, "A").Value, SearchOrder:=xlByRows)
        If rEmployee Is Nothing Then
            Set rEmployee = shRes.Cells(Cells.Rows.Count, "A").End(xlUp).Offset(1)
            rEmployee.Value = shData.Cells(i, "A").Value
        End If
        Set rProject = rEmployee.EntireRow.Find(shData.Cells(i, "B").Value, SearchOrder:=xlByColumns)
            If rProject Is Nothing Then
                shRes.Cells(rEmployee.Row, y).End(xlToLeft).Offset(, 1).Value = _
                shData.Cells(i, "B").Value
            End If
    Next
    shRes.Rows(1).Delete
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub
 
Upvote 0
pjingle,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


I assume that your raw data is in worksheet Sheet1, and, that the results should be written to worksheet Sheet2.


Sample raw data:


Excel 2007
AB
1EmployeeProject
2AMEYV32710-NDIA-1000
3AMEYV32687-POST-1000
4AMEYV32710-NDIA-1000
5AMEYV32710-NDIA-1000
6BRADYS32708-CDGP-1000
7BRADYS32723-FSRP-1000
8BRADYS32723-FSRP-1000
9BRADYS32723-FSRP-1000
10CANDLINT32666-DMOS-1000
11CANDLINT32666-DMOS-1000
12CANDLINT32666-DMOS-1000
13COLECQES5283-3223
14COLECQES5283-4206
15COLECQES5429-4000
16COLECQES5283-4206
17COLECQES5283-4206
18COLECQES5283-4206
19DAVIESCL32724-FSRP-1000
20DAVIESCL32724-FSRP-1000
21
Sheet1


After the macro in worksheet Sheet2:


Excel 2007
ABCD
1EmployeeProject
2AMEYV32687-POST-100032710-NDIA-1000
3BRADYS32708-CDGP-100032723-FSRP-1000
4CANDLINT32666-DMOS-1000
5COLECQES5283-3223QES5283-4206QES5429-4000
6DAVIESCL32724-FSRP-1000
7
Sheet2


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Sub ReorgData()
' hiker95, 10/18/2014, ME812244
Dim r As Long, lr As Long, n As Long
Application.ScreenUpdating = False
Sheets("Sheet2").UsedRange.ClearContents
Sheets("Sheet1").Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Sheet2").Columns("A:B"), Unique:=True
Application.CutCopyMode = False
With Sheets("Sheet2")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("A2:B" & lr).Sort key1:=.Range("A2"), order1:=1, key2:=.Range("B2"), order2:=1
  For r = 2 To lr
    n = Application.CountIf(.Columns(1), .Cells(r, 1).Value)
    If n > 1 Then
      .Range("B" & r).Resize(, n).Value = Application.Transpose(.Range("B" & r & ":B" & r + n - 1).Value)
      .Range("A" & r + 1 & ":B" & r + 1 + n - 2).ClearContents
    End If
    r = r + n - 1
  Next r
  For r = lr To 2 Step -1
    If .Cells(r, 1) = "" Then .Rows(r).Delete
  Next r
  .UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.
 
Upvote 0

Forum statistics

Threads
1,214,583
Messages
6,120,383
Members
448,956
Latest member
JPav

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
Back
Top