Get unique values from table (Listobject) and import to another Table

[aloxaz]

Guys,

i m trying to get the unique values from excel table (declare as listobject) and import them to another table (declare as listobject).the issue is that when a paste the values ,the first two values are the same and the table don't resize. Code posted below:

ActiveSheet.ListObjects("tblNames").ListColumns(1).DataBodyRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.ListObjects("tblTest2").ListColumns(1).DataBodyRange, Unique:=True

Thanks for helping me out

 

[igold]

It's a little more code than your one liner, but see if this gets you any closer...

Sub test()


    Dim tbl As ListObject
    Dim arr
    Dim x As Long
    Dim rng As Range
    
    arr = ActiveSheet.ListObjects("tblNames").ListColumns(1).DataBodyRange
    With CreateObject("Scripting.Dictionary")
        For x = LBound(arr) To UBound(arr)
            If Not IsMissing(arr(x, 1)) Then .Item(arr(x, 1)) = 1
        Next
        arr = .Keys
    End With
    
    Set tbl = ActiveSheet.ListObjects("tblTest2")
    Set rng = Range("tblTest2[#All]").Resize(UBound(arr, 1), tbl.Range.Columns.Count)
    tbl.Resize rng
    tbl.HeaderRowRange.Resize(UBound(arr, 1) + 1).Offset(1).Value = Application.Transpose(arr)
  
End Sub