copy unique values from column to row

Question

how can i copy unique values from a column in one Excel sheet to a row in another excel sheet using vba code?

i have a list of values at sheet1 column B which contains duplictes, and i want to copy it to sheet 2 row 1 without duplicates, i have tried:

Public Sub Test()

ActiveSheet.Range("B2:B65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2).Range("D1"), Unique:=True

End Sub

but it does not work and also does not use the fact that not all of the column contains values.

how can i do that?

This previous answer should be of help: stackoverflow.com/a/7440911/2119523 — Netloh
thank you, i've seen this comment and wanted to know what adjustments need to be made for copying it to a row and not a column — user3350919

Gary's Student Gary's Student · Accepted Answer · 2014-02-26T15:09:16

Try MAIN

Sub MAIN()
    Dim N As Long
    Dim cl As Collection
    N = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
    Set cl = MakeColl(ActiveSheet.Range("B1:B" & N))
    Call FillRange(Sheets(2).Range("D1:IV1"), cl)
End Sub

Public Function MakeColl(rng As Range) As Collection
    Set MakeColl = New Collection
    Dim r As Range
    On Error Resume Next
    For Each r In rng
        v = r.Value
        If v <> "" Then
            MakeColl.Add v, CStr(v)
        End If
    Next r
End Function

Sub FillRange(rng As Range, col As Collection)
    Dim I As Long, r As Range, J As Long
    I = 1
    J = col.Count
    For Each r In rng
        MsgBox r.Parent.Name & r.Address(0, 0)
        r.Value = col.Item(I)
        If I = J Then Exit Sub
        I = I + 1
    Next r
End Sub

copy unique values from column to row

2 Answers