GerryZ,
1. What version of Excel and Windows are you using?
2. Are you using a PC or a Mac?
The following macro should adjust for a varying number of rows, and, columns. And, there should not be any information to the right of the last used column for your raw data.
The names are in row 1, beginning in cell A1, and, to the right without any blank cells.
The results will be written beginning in row 1, in the column two columns to the right of the last used column of your raw data.
Sample raw data:
| Excel 2007 |
|---|
|
|---|
| A | B | C | D | E | F | G | H | I | J | K |
|---|
| 1 | FRANK | GEORGE | JULIE | MIKAEL | LUIS | | | | | | |
|---|
| 2 | APPLE | KIWI | APPLE | TANGERINE | KIWI | | | | | | |
|---|
| 3 | ORANGE | ORANGE | KIWI | TANGERINE | PEAR | | | | | | |
|---|
| 4 | ORANGE | ORANGE | ORANGE | TANGERINE | PEAR | | | | | | |
|---|
| 5 | APPLE | ORANGE | ORANGE | ORANGE | PEAR | | | | | | |
|---|
| 6 | PEAR | ORANGE | ORANGE | ORANGE | KIWI | | | | | | |
|---|
| 7 | PEAR | ORANGE | ORANGE | ORANGE | KIWI | | | | | | |
|---|
| 8 | | KIWI | | | | | | | | | |
|---|
| 9 | | | | | | | | | | | |
|---|
|
|---|
| Excel 2007 |
|---|
|
|---|
| A | B | C | D | E | F | G | H | I | J | K |
|---|
| 1 | FRANK | GEORGE | JULIE | MIKAEL | LUIS | | APPLE | ORANGE | PEAR | KIWI | TANGERINE |
|---|
| 2 | APPLE | KIWI | APPLE | TANGERINE | KIWI | | FRANK | FRANK | FRANK | GEORGE | MIKAEL |
|---|
| 3 | ORANGE | ORANGE | KIWI | TANGERINE | PEAR | | JULIE | GEORGE | LUIS | JULIE | |
|---|
| 4 | ORANGE | ORANGE | ORANGE | TANGERINE | PEAR | | | JULIE | | LUIS | |
|---|
| 5 | APPLE | ORANGE | ORANGE | ORANGE | PEAR | | | MIKAEL | | | |
|---|
| 6 | PEAR | ORANGE | ORANGE | ORANGE | KIWI | | | | | | |
|---|
| 7 | PEAR | ORANGE | ORANGE | ORANGE | KIWI | | | | | | |
|---|
| 8 | | KIWI | | | | | | | | | |
|---|
| 9 | | | | | | | | | | | |
|---|
|
|---|
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 ExractUniqueList()
' hiker95, 11/29/2014, ME821197
Dim r As Long, lr As Long, lc As Long, c As Long
Dim rng As Range, d As Range, a
Dim f As Range, na As Range, nr As Long
Application.ScreenUpdating = False
lr = Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
With CreateObject("Scripting.Dictionary")
For c = 1 To lc
Set rng = Range(Cells(2, c), Cells(lr, c))
For Each d In rng
If d <> "" Then
If Not .Exists(d.Value) Then
.Add d.Value, d.Value
End If
End If
Next
Next c
a = Application.Transpose(Array(.Keys))
End With
Cells(1, lc + 2).Resize(, UBound(a)) = Application.Transpose(a)
For c = 1 To lc
For r = 2 To lr
If Cells(r, c) <> "" Then
Set f = Rows(1).Find(Cells(r, c).Value, LookAt:=xlWhole)
If Not f Is Nothing Then
Set na = Columns(f.Column).Find(Cells(1, c).Value, LookAt:=xlWhole)
If na Is Nothing Then
nr = Cells(Rows.Count, f.Column).End(xlUp).Row + 1
Cells(nr, f.Column).Value = Cells(1, c).Value
End If
End If
End If
Next r
Next c
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
You may have to add the
Microsoft Scripting Runtime to the
References - VBA Project.
With your workbook that contains the above:
Press the keys
ALT +
F11 to open the Visual Basic Editor
In the VBA Editor, click on:
Tools
References...
Put a checkmark in the box marked
B]Microsoft Scripting Runtime[/B]
Then click on the
OK button.
And, exit out of the VBA Editor.
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
ExractUniqueList macro.
