CODEWITHSUNDEEP
vbaexcel
Sebastian Ong
Sebastian Ong

Reputation: 65

VBA: How do I get unique values in a column and insert it into an array?

I have seen multiple codes regarding this topic but I can't seem to understand it.

For instance, if I have a column that records people names, I want to record all unique names into the array.

So if I have a column of names

David
Johnathan
Peter
Peter
Peter
Louis
David

I want to utilize VBA to extract unique names out of the column and place it into an array so when I call the array it would return these results

Array[0] = David
Array[1] = Johnathan
Array[2] = Peter
Array[3] = Louis

Upvotes: 1

Views: 9006

Answers (5)

Tomas Trdla
Tomas Trdla

Reputation: 1202

If you dont want to use "Scripting.Dictionary" and your excel does not have Worksheet.unique(...) like mine

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    If UBound(arr) >= 0 Then
        IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
    Else
        IsInArray = False
    End If
End Function

Public Function GetUniqueValuesFromColumn(ws As Worksheet, sourceColNum As Long, Optional firstRow As Long = 2) As Variant
    Dim val As String
    Dim i As Long
    Dim arr() As Variant
    arr = Array()
    For i = firstRow To ws.Cells(Rows.Count, sourceColNum).End(xlUp).Row
        val = ws.Cells(i, sourceColNum)
        If Not IsInArray(val, arr) Then
            ReDim Preserve arr(UBound(arr) + 1)
            arr(UBound(arr)) = val
        End If
    Next i
    GetUniqueValuesFromColumn = arr
End Function

Then call it like GetUniqueValuesFromColumn(ThisWorkbook.Worksheets("SomeList"), 1)

Upvotes: 0

Storax
Storax

Reputation: 12167

You could use Excel functionality like that.

Sub UniqueNames()

Dim vDat As Variant
Dim rg As Range
Dim i As Long

    Set rg = Range("A1:A7")

    rg.RemoveDuplicates Columns:=Array(1), Header:=xlNo
    With ActiveSheet
        vDat = WorksheetFunction.Transpose(.Range("A1:" & .Range("A1").End(xlDown).Address))
    End With

    For i = LBound(vDat) To UBound(vDat)
        Debug.Print vDat(i)
    Next i

End Sub

Code is based on your example data, i.e. I put your data into column 1. But the code will also alter the table. If you do not want that you have to use other solutions or put the data beforehand in a temporary sheet.

Upvotes: 2

teylyn
teylyn

Reputation: 35900

Is this a VBA question or a question about programming logic? Use a loop on the column with the data. Check each name against the list of existing data items. If it exists in the list, move on the the next name. If it does not exist in the list, add it.

The "list" is a concept, not a concrete tool. It can be a VBA dictionary, if you are comfortable using that. Or it can be a VBA array, which may not perform as fast as a dictionary, but may be more familiar.

Then again, if you add the data to the Excel Data Model, you can use the Distinct aggregation of a pivot table to list out the unique values.

Without more background it's hard to tell if VBA or Data Model is your best approach. Many VBA solutions get created because people are not aware of Excel's capabilities.

Upvotes: 2

DisplayName
DisplayName

Reputation: 13386

use Dictionary object and build a Function that returns your array

Function GetUniqeNames(myRng As Range) As Variant
    Dim cell As Range

    With CreateObject("Scripting.Dictionary") ' instantiate and reference a Dictionary object
        For Each cell In myRng ' loop through passed range
            .Item(cell.Value2) = 1 ' store current cell name into referenced dictionary keys (duplicates will be overwritten)
        Next
    GetUniqeNames = .keys ' write referenced dictionary keys into an array
    End With
End Function

that you can exploit in your main code as follows

Sub main()
    Dim myArray As Variant

    With Worksheets("mysheet") ' change "mysheet" to your actual sheet name
        myArray = GetUniqeNames(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp))) ' this will take the referenced sheet column A range from row 1 down to last not empty one
    End With

End Sub

Upvotes: 4

ThunderFrame
ThunderFrame

Reputation: 9461

Despite a Collection being mentioned and being a possible solution, it is far more efficient to use a Dictionary as it has an Exists method. Then it's just a matter of adding the names to the dictionary if they don't already exist, and then extracting the keys to an array when you're done.

Note that I've made the name comparisons case-sensitive, but you can change that if necessary, to case-insensitive.

Option Explicit

Sub test()

   'Extract all of the names into an array
    Dim values As Variant
    values = Sheet1.Range("Names").Value2 'Value2 is faster than Value

    'Add a reference to Microsoft Scripting Runtime
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary

    'Set the comparison mode to case-sensitive
    dic.CompareMode = BinaryCompare

    Dim valCounter As Long
    For valCounter = LBound(values) To UBound(values)
        'Check if the name is already in the dictionary
        If Not dic.Exists(values(valCounter, 1)) Then
            'Add the new name as a key, along with a dummy value of 0
            dic.Add values(valCounter, 1), 0
        End If
    Next valCounter

    'Extract the dictionary's keys as a 1D array
    Dim result As Variant
    result = dic.Keys

End Sub

Upvotes: 4

Related Questions