Snasui Excel Forum

Code: Select all

Sub UniqueList()
Dim rListPaste As Range
Dim iReply As Integer

On Error Resume Next

Set rListPaste = Application.InputBox _
(Prompt:="Please select the destination cell", Type:=8)

    If rListPaste Is Nothing Then
       iReply = MsgBox("No range nominated," _
          & " terminate", vbYesNo + vbQuestion)
      If iReply = vbYes Then Exit Sub
    End If

'May need to specify [NameofSheet].Range, e.g, Sheet1.Range
   Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
   Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True
End Sub

Code: Select all

Sub UniqueList()
    On Error Resume Next
    'May need to specify [NameofSheet].Range, e.g, Sheet1.Range
    Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
    Action:=xlFilterCopy, CopyToRange:=Sheets("Sheet1").Cells(1, "C"), Unique:=True
End Sub