Array of unique values in a Column range

Question

Trying to figure out the code to make an array of all unique values in a column.

So like say from C3:C30 I want an array named divisionNames of all unique values in that range. I intend to use the array later in the code. Trying to figure out a minimalist way of doing it so I don't add like 60 more lines of code to the macro.

Would be very appreciative of any suggestions

UPDATE:

Gary's Student's response below did the trick for what I needed, but I very much appreciate the help everyone gave. Thank you. Also as a side note I am now realizing I should have added that I am using Office 365. To be honest I didn't realize it made that much of a difference, but I will remember that for future reference and again thank you for all of the help

Sub uniq()
    With Application.WorksheetFunction
        divisionNames = .Unique(Range("C3:C30"))
    End With
End Sub

Here is a way using a dictionary: stackoverflow.com/a/36044716/1521579 — Ricardo Diaz
– Ricardo Diaz, Commented Oct 30, 2020 at 18:55
What kind of an array do you need? 1D 0-based, 1D 1-based or 2D 1-based? The 2D 1-based is easily pasted into a column range: Range("A1").Resize(Ubound(Data, 1), Ubound(Data, 2)).Value = Data. No transpose necessary. — VBasic2008
– VBasic2008, Commented Oct 30, 2020 at 19:31
To be honest I just needed a...list I suppose of names so I can later stick those into a ComboBox later on. Gary's Student's response below did the trick for me. Thank you guys for taking the time to respond though, it is honestly appreciated. I honestly am very appreciative of all of the amazing people on these forums. — GeekyMeeks
– GeekyMeeks, Commented Oct 30, 2020 at 21:49

Gary's Student · Accepted Answer · 2020-10-30 21:57:33Z

5

With Excel 365:

Sub uniq()
    With Application.WorksheetFunction
        divisionNames = .Unique(Range("C3:C30"))
    End With
End Sub

EDIT#1:

This version will sort the results and put the data in column D:

Sub uniq()
    With Application.WorksheetFunction
        divisionNames = .Unique(Range("C3:C30"))
        divisionNames = .Sort(divisionNames)
    End With
    
    u = UBound(divisionNames, 1)
    Range("D3:D" & 3 + u - 1).Value = divisionNames
    
End Sub

edited Oct 30, 2020 at 21:57

answered Oct 30, 2020 at 19:03

Gary's Student

96.9k10 gold badges66 silver badges104 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

GeekyMeeks Over a year ago

That does the job, thank you, the only thing I need to figure out now is if I can sort the data in divisionNames alphabetically, but that is just a nicety

Gary's Student Over a year ago

@GeekyMeeks See my EDIT#1

VBasic2008 · Accepted Answer · 2020-10-30 19:52:10Z

Unique (Dictionary)

There is no error handling i.e. it is assumed that the range is a one-column range and that there are no error or empty values. This could be easily implemented, but you wanted it short.

1D - Function

Function getUniqueColumn1D(ColumnRange As Range)
    Dim Data As Variant
    Data = ColumnRange.Resize(, 1).Value
    With CreateObject("Scripting.Dictionary")
        Dim i As Long
        For i = 1 To UBound(Data)
            .Item(Data(i, 1)) = Empty
        Next
        ReDim Data(1 To .Count)
        i = 0
        Dim key As Variant
        For Each key In .Keys
            i = i + 1
            Data(i) = key
        Next key
    End With
    getUniqueColumn1D = Data
End Function

Sub test1D()
    Dim rng As Range
    Set rng = Range("C3:C30")
    Dim Data As Variant
    Data = getUniqueColumn1D(rng)
    Debug.Print Join(Data, vbLf)
End Sub

2D - Function

Function getUniqueColumn(ColumnRange As Range)
    Dim Data As Variant
    Data = ColumnRange.Resize(, 1).Value
    With CreateObject("Scripting.Dictionary")
        Dim i As Long
        For i = 1 To UBound(Data)
            .Item(Data(i, 1)) = Empty
        Next
        ReDim Data(1 To .Count, 1 To 1)
        i = 0
        Dim key As Variant
        For Each key In .Keys
            i = i + 1
            Data(i, 1) = key
        Next key
    End With
    getUniqueColumn = Data
End Function

Sub TESTgetUniqueColumn()
    Dim rng As Range
    Set rng = Range("C3:C30")
    Dim Data As Variant
    Data = getUniqueColumn(rng)
    ' e.g.
    Dim i As Long
    For i = 1 To UBound(Data)
        Debug.Print Data(i, 1)
    Next i
    ' or:
    Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
End Sub

2D - Sub

Sub getUniqueColumnSub()
    Dim Data As Variant
    Data = Range("C3:C30")
    With CreateObject("Scripting.Dictionary")
        Dim i As Long
        For i = 1 To UBound(Data)
            .Item(Data(i, 1)) = Empty
        Next
        ReDim Data(1 To .Count, 1 To 1)
        i = 0
        Dim key As Variant
        For Each key In .Keys
            i = i + 1
            Data(i, 1) = key
        Next key
    End With
    
    ' e.g.
    For i = 1 To UBound(Data)
        Debug.Print Data(i, 1)
    Next i
    ' or:
    Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
End Sub

Thank you for the reply. I hope that didn't take too long to make (Would have taken me like an hour if not MUCH longer) I very much appreciate you taking the time to reply though. Gary's Student's reply did the trick and its nice and short. Just wanted to say thank you for taking the time to type that all out
@GeekyMeeks: Don't worry, I wrote it for users that might not have 365. But thanks for the feedback. 3 lines against 15: that's a no-brainer.

Collectives™ on Stack Overflow

Array of unique values in a Column range

2 Answers 2

2 Comments

Unique (Dictionary)

2 Comments

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Unique (Dictionary)

2 Comments

Linked

Related