Copy unique values from two column in single column

[sooshil]

I have a table: Table1
AnyColumn1 and AnyColumn2 are two columns in Table1 which always have text values.
Those two columns may contain same text values in different rows as shown in picture.

Test.xlsm
	B	C
1	AnyColumn1	AnyColumn2
2	Value1	Value150
3	Value2	Value2
4	Value3	Value150
5	Value150	Value7
Sheet1

I want to copy unique values from both the columns and paste it into a given cell/range (1 column width) in ascending order.
The result of the above example should come like this.

Test.xlsm
	G
4	Value1
5	Value150
6	Value2
7	Value3
8	Value7
Sheet1

Thank you.

 

[COwen]

You could use a PivotTable

 

[DanteAmor]

I want to copy unique values from both the columns

Here is a macro for you to consider,

Sub unique_values()
  Dim coll As Object, c As Range, dict As Object, ky As Variant
  Set coll = CreateObject("System.Collections.ArrayList")
  Set dict = CreateObject("Scripting.Dictionary")
  For Each c In ActiveSheet.ListObjects("Table1").DataBodyRange
    dict(c.Value) = Empty
  Next
  For Each ky In dict.keys
    coll.Add ky
  Next
  coll.Sort
  Range("G4").Resize(dict.Count).Value = Application.Transpose(coll.toArray)
End Sub

 

[HappierThan]

Copy all data into Column G; use Data>Remove Duplicates>Data>Sort A-Z.

 

[sooshil]

Here is a macro for you to consider,

Sub unique_values()
  Dim coll As Object, c As Range, dict As Object, ky As Variant
  Set coll = CreateObject("System.Collections.ArrayList")
  Set dict = CreateObject("Scripting.Dictionary")
  For Each c In ActiveSheet.ListObjects("Table1").DataBodyRange
    dict(c.Value) = Empty
  Next
  For Each ky In dict.keys
    coll.Add ky
  Next
  coll.Sort
  Range("G4").Resize(dict.Count).Value = Application.Transpose(coll.toArray)
End Sub

Thank you so much DanteAmor
It worked.

 

[DanteAmor]

Glad we could help & thanks for the feedback

 

[Peter_SSs]

As another approach, if you were interested in a more direct, non-looping, method (more along the lines of HappierThan's suggestion) then you could try ..

Sub UniqueAndsort()
  Dim DBR As Range
  
  Set DBR = ActiveSheet.ListObjects("Table1").DataBodyRange
  With Range("G4").Resize(DBR.Count)
    .Value = Application.Transpose(Split(Join(Application.Transpose(Evaluate(DBR.Columns(1).Address & "&""|""&" & DBR.Columns(2).Address)), "|"), "|"))
    .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlTopToBottom
    .RemoveDuplicates Columns:=1, Header:=xlNo
  End With
End Sub

 

[sandy666]

another approach with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    C2T = Table.FromList(Table.ToColumns(Source), Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    Expand = Table.ExpandListColumn(C2T, "Column1"),
    Sort = Table.Sort(Table.Distinct(Expand),{{"Column1", Order.Ascending}})
in
    Sort

 

[Peter_SSs]

another approach ...

Hmm, not sure if the OP will be interested in more approaches after this time, but since the thread has been resurrected, a formula approach is also possible:

sooshil 2020-06-30 1.xlsm
	A	B	C	D
1	AnyColumn1	AnyColumn2		Unique List
2	Value1	Value150		Value1
3	Value2	Value2		Value150
4	Value3	Value150		Value2
5	Value150	Value7		Value3
6				Value7
7
8
Sheet2

Cell Formulas
Range	Formula
D2:D8	D2	=IFERROR(INDIRECT(TEXT(AGGREGATE(15,6,(ROW(Table1)*10^6+COLUMN(Table1))/((Table1<>"")*(ISNA(MATCH(Table1,D$1:D1,0)))),1),"R000000C000000"),0),"")