List cells in a range into one column

[mikec82]

I have a sheet that looks like this:

First	Last	ID 1	ID 2	ID 2
Mark	Smith	0005-123	0005-456	0005-789
John	Turner	0005-234	0005-567	0005-8910
Mary	Richards	0005-345	0005-678	0005-8911

<tbody>
</tbody>

I need to have one column in a second sheet that lists everything in ID 2 and ID3 so that I have this:

IDs

0005-456

0005-567

0005-678

0005-789

0005-8910

0005-8911

<tbody>
</tbody>

Is this possible? Would this be a VLOOKUP? I want to make sure that it only lists unique values - no duplicates.

 

[jim may]

Paste the below code into a Standard Module of your VBE. Then whatever Range of Cells you wish to INCLUDE in the transfer simply HIGHLIGHT them, or select then
In your case Highlight Range D2:E4. Run from this same page (Sheet1). Afterwards check your Sheet2 Column A...
Jim

Sub Foo()
Dim arr() As Variant
Dim Rng As Range, c As Range
Dim j As Integer, TCnt As Integer, i As Integer
Set Rng = Selection
TCnt = Rng.Count
For Each c In Rng
    ReDim Preserve arr(i)
    arr(i) = c
    i = i + 1
Next c
With Worksheets("Sheet2")
For j = 0 To TCnt - 1
    .Cells(j + 2, 1) = arr(j)
Next j
End With
End Sub

 

[sandy666]

you can try PowerQuery aka Get&Transform

[SIZE=1]let
    Source = Excel.CurrentWorkbook(){[Name="Table9"]}[Content],
    ROC = Table.ToColumns(Table.SelectColumns(Source,{"ID 2", "ID 22"})),
    ToTable = Table.FromList(ROC, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    Expand = Table.ExpandListColumn(ToTable, "Column1"),
    Rename = Table.RenameColumns(Expand,{{"Column1", "IDs"}})
in
    Rename[/SIZE]

First	Last	ID 1	ID 2	ID 22		IDs
Mark	Smith	0005-123	0005-456	0005-789		0005-456
John	Turner	0005-234	0005-567	0005-8910		0005-567
Mary	Richards	0005-345	0005-678	0005-8911		0005-678
						0005-789
						0005-8910
						0005-8911

 

[DanteAmor]

Try this, change "Data" and "ID" by the names of your sheets.

Sub Macro1()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = Sheets("[COLOR=#ff0000]Data[/COLOR]")
    Set sh2 = Sheets("[COLOR=#ff0000]ID[/COLOR]")
    lr = sh1.Range("D" & Rows.Count).End(xlUp).Row
    sh2.Range("A2").Resize(lr - 1).Value = sh1.Range("D2:D" & lr).Value
    sh2.Range("A" & lr + 1).Resize(lr - 1).Value = sh1.Range("E2:E" & lr).Value
    sh2.Range("A2:A" & lr * 2 - 1).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub