array of unique values in a range of columns

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

CLICK HERE to find out more related problems solutions.

Leave a Comment

Your email address will not be published.

Scroll to Top