List cells in a range into one column

[mikec82]

I have a sheet that looks like this:

[TABLE="class: grid, width: 750, align: left"]
<tbody>[TR]
[TD]First[/TD]
[TD]Last[/TD]
[TD]ID 1[/TD]
[TD]ID 2[/TD]
[TD]ID 2[/TD]
[/TR]
[TR]
[TD]Mark[/TD]
[TD]Smith[/TD]
[TD]0005-123[/TD]
[TD]0005-456[/TD]
[TD]0005-789[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Turner[/TD]
[TD]0005-234[/TD]
[TD]0005-567[/TD]
[TD]0005-8910[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[TD]Richards[/TD]
[TD]0005-345[/TD]
[TD]0005-678[/TD]
[TD]0005-8911[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]IDs[/TD]
[/TR]
[TR]
[TD]0005-456[/TD]
[/TR]
[TR]
[TD]0005-567[/TD]
[/TR]
[TR]
[TD]0005-678[/TD]
[/TR]
[TR]
[TD]0005-789[/TD]
[/TR]
[TR]
[TD]0005-8910[/TD]
[/TR]
[TR]
[TD]0005-8911[/TD]
[/TR]
</tbody>[/TABLE]

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]

[Table="width:, class:head"]
[tr=bgcolor:#FFFFFF][td=bgcolor:#5B9BD5]First[/td][td=bgcolor:#5B9BD5]Last[/td][td=bgcolor:#5B9BD5]ID 1[/td][td=bgcolor:#5B9BD5]ID 2[/td][td=bgcolor:#5B9BD5]ID 22[/td][td][/td][td=bgcolor:#70AD47]IDs[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#DDEBF7]Mark[/td][td=bgcolor:#DDEBF7]Smith[/td][td=bgcolor:#DDEBF7]0005-123[/td][td=bgcolor:#DDEBF7]0005-456[/td][td=bgcolor:#DDEBF7]0005-789[/td][td][/td][td=bgcolor:#E2EFDA]0005-456[/td][/tr]

[tr=bgcolor:#FFFFFF][td]John[/td][td]Turner[/td][td]0005-234[/td][td]0005-567[/td][td]0005-8910[/td][td][/td][td]0005-567[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#DDEBF7]Mary[/td][td=bgcolor:#DDEBF7]Richards[/td][td=bgcolor:#DDEBF7]0005-345[/td][td=bgcolor:#DDEBF7]0005-678[/td][td=bgcolor:#DDEBF7]0005-8911[/td][td][/td][td=bgcolor:#E2EFDA]0005-678[/td][/tr]

[tr=bgcolor:#FFFFFF][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td]0005-789[/td][/tr]

[tr=bgcolor:#FFFFFF][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td=bgcolor:#E2EFDA]0005-8910[/td][/tr]

[tr=bgcolor:#FFFFFF][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td]0005-8911[/td][/tr]
[/table]

 

[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