CODEWITHSUNDEEP
arraysexcelvbaunique
GeekyMeeks
GeekyMeeks

Reputation: 13

Array of unique values in a Column range

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

Upvotes: 0

Views: 6373

Answers (2)

Gary's Student
Gary's Student

Reputation: 96781

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

enter image description here

Upvotes: 5

VBasic2008
VBasic2008

Reputation: 54948

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

Upvotes: 1

Related Questions