Generate list of unique values

[SR1]

I am trying to create a VBA script to do the above but the problem is even with screen updating turned off it takes a long time to run. Here is my code:

Sub ListOfUniqueValues()
Application.ScreenUpdating = False
Dim r As Integer, c As Integer
r = ActiveCell.Row + 1
c = ActiveCell.Column
Do Until Cells(r, c) = ""
If Cells(r, c) = Cells(r - 1, c) Then
Rows(r).Delete
Else: r = r + 1
End If
Loop
Application.ScreenUpdating = True
End Sub

As you can see the code requires you to select the topmost cell of the list. It would be handier if I can just generate the list of unique values by (a) clicking anywhere in the list and (b) being able to post the original list anywhere in the worksheet so that whole rows containing other data are not deleted - I only want to delete the cells containing duplicates. All this obviously in code that runs much more quickly. Can anyone advise?

EDIT: this assumes the list is in alphabetical order, so again I just want to be able to dump the list anywhere in the worksheet, and make Excel do the sorting and deleting of duplicates without affecting the rest of the data if there is any. Thanks!

 

[footoo]

If you mean that you want to select any single cell in any data column and put the unique values from that column into a blank column then :

Sub ft()
Dim rng As Range, c%, dc%
If Selection.Cells.Count > 1 Then
    MsgBox "Select one cell only"
Exit Sub
End If
c = Selection.Column
dc = Range([A1], ActiveSheet.UsedRange).Columns.Count + 2
Set rng = Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
Application.ScreenUpdating = False
With rng.Offset(0, dc - c)
    .Value = rng.Value
    .RemoveDuplicates Columns:=1, Header:=xlNo
End With
Application.ScreenUpdating = True
End Sub

 

[SR1]

Thanks, that seems to have done the trick.

But is there a way to produce the list of unique values in the same column as the original list replacing that list and with the same starting point? Or failing that, the next column with the same starting point?

 

[footoo]

Thanks, that seems to have done the trick.

But is there a way to produce the list of unique values in the same column as the original list replacing that list and with the same starting point? Or failing that, the next column with the same starting point?

Sub ft()
Dim rng As Range, c%
If Selection.Cells.Count > 1 Then
    MsgBox "Select one cell only"
Exit Sub
End If
c = Selection.Column
Set rng = Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
Application.ScreenUpdating = False
rng.RemoveDuplicates Columns:=1, Header:=xlNo
Application.ScreenUpdating = True
End Sub

 

[SR1]

Unfortunately that came up with the run-time error 1004, with this line highlighted:

rng.RemoveDuplicates Columns:=1, Header:=xlNo

I tested it on a short list a few columns away from a block of data.

 

[footoo]

It works for me. I can't reproduce this error.
Post some sample data where it doesn't work.
Try this :

Sub ft()
Dim rng As Range, c%
If Selection.Cells.Count > 1 Then
    MsgBox "Select one cell only"
Exit Sub
End If
c = Selection.Column
Set rng = Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
Application.ScreenUpdating = False
[COLOR=#ff0000]rng.Select[/COLOR]
rng.RemoveDuplicates Columns:=1, Header:=xlNo
Application.ScreenUpdating = True
End Sub

 

[footoo]

Try this :

Sub ft()
If Selection.Columns.Count > 1 Then
    MsgBox "Select in one column only"
    Exit Sub
End If
Columns(Selection.Column).RemoveDuplicates Columns:=1, Header:=xlYes
End Sub