Friday, February 24, 2012

Using the Inputbox to create a unique list from Column A:

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



  Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _

   Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True

End Sub

No comments:

Post a Comment