VBA unique cells

[jakobt]

Have a range of cells F4:F50.

I now want to write a VBA code to enter all unique items from the range in cell:


C55 and onwards

Preferably in alphabetic order..

 

[jmacleary]

Hi there. To solve this, I just recorded a macro to do what you described. Here it is:

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("F4:F50").Select
    Selection.Copy
    Range("C55").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$C$55:$C$101").RemoveDuplicates Columns:=1, Header:=xlNo
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C55:C101") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("C55:C101")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C55").Select
End Sub

Note that it only works on the exact cell ranges you specified, and requires you to have the correct worksheet activated when you run it.

 

[Yongle]

or ... you could try this ...

Sub UniqueInSequence()
    Dim rng As Range: Set rng = Range("F4:F50")
    With Range("C55").Resize(rng.Rows.Count)
        .Value = rng.Value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        .Sort Key1:=Range("C55"), Order1:=xlAscending, Header:=xlNo
    End With
End Sub