Search code examples
arraysexcelvbaunique

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

Solution

  • 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