Get Unique Values Using Advanced Filters Not Worki

Question

I have two sheets:

Sheet 2:

Column C
Supplier Name
A
A
B
B
C

Sheet 1 (Desired Result)

Column G
A
B
C

I am trying to create a list of unique supplier names in column G on Sheet 1, as shown above.

I am using this code:

Sub LIST()
    Dim r1 As Range, r2 As Range

    Dim lastrow As Long
    lastrow = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).row

    Set r1 = Sheets("Data").Range("C2:C" & lastrow)
    Set r2 = Sheets("Sheet1").Range("G16")

    r1.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r2, unique:=True



End Sub

This code is not working correctly. It shows the first supplier name A as duplicated like so:

Sheet 1

Column G
A
A
B
C

Answer 1

Advanced Filter requires a header row that it carries across in a Copy To operation. Since you have not assinged or included one, the r1.AdvancedFilter command assumes that C2 is the header row.

Change Range("C2:C" & lastrow) to Range("C1:C" & lastrow) so that Advanced Filter has a header row to carry across.

Sub LIST()
    Dim r1 As Range, r2 As Range

    Dim lastrow As Long
    lastrow = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Row

    Set r1 = Sheets("Data").Range("C1:C" & lastrow)
    Set r2 = Sheets("Sheet1").Range("G16")

    r1.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=r2, Unique:=True

End Sub

Note that you will be carrying C1 across to Sheet1!G16. Delete it if is not desired.

Alternate with direct value transfer and RemoveDuplicates instead of AdvancedFilter.

Sub nodupeLIST()
    Dim r1 As Range, lastrow As Long

    With Worksheets("Data")
        lastrow = .Cells(Rows.Count, "C").End(xlUp).Row
        Set r1 = .Range("C2:C" & lastrow)
    End With

    With Worksheets("Sheet1")
        With .Range("G16").Resize(r1.Rows.Count, 1)
            .Cells = r1.Value
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
    End With

End Sub