Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How do I get a list of unique values from a range in Excel VBA?

Tags:

excel

vba

I would like to get a list of unique values in a range using VBA. Most examples in Google talk about getting a list of unique values in a column using VBA.

I am not sure how to change it to get a list of value in a range.

For example,

Currency    Name 1  Name 2  Name 3  Name 4  Name 5
SGD BGN DBS         
PHP PDSS                
KRW BGN             
CNY CBBT    BGN         
IDA INPC                

My array should look like:

BGN, DBS, PDSS, CBBT and INPC.

How do I do it? Need some guidance.

like image 1000
lakshmen Avatar asked Jul 29 '15 03:07

lakshmen


People also ask

How do I get a list of unique values from a range in Excel?

To filter for unique values, click Data > Sort & Filter > Advanced. To remove duplicate values, click Data > Data Tools > Remove Duplicates. To highlight unique or duplicate values, use the Conditional Formatting command in the Style group on the Home tab.


2 Answers

I would use a simple VBA-Collection and add items with key. The key would be the item itself and because there can't be duplicit keys the collection will contain unique values.

Note: Because adding duplicit key to collection raises error wrap the call to collection-add into a on-error-resume-next.

The function GetUniqueValues has source-range-values as parameter and retuns VBA-Collection of unique source-range-values. In the main method the function is called and the result is printed into Output-Window. HTH.

Sample source range looked like this: enter image description here

Option Explicit

Sub main()
    Dim uniques As Collection
    Dim source As Range

    Set source = ActiveSheet.Range("A2:F6")
    Set uniques = GetUniqueValues(source.Value)

    Dim it
    For Each it In uniques
        Debug.Print it
    Next
End Sub

Public Function GetUniqueValues(ByVal values As Variant) As Collection
    Dim result As Collection
    Dim cellValue As Variant
    Dim cellValueTrimmed As String

    Set result = New Collection
    Set GetUniqueValues = result

    On Error Resume Next

    For Each cellValue In values
        cellValueTrimmed = Trim(cellValue)
        If cellValueTrimmed = "" Then GoTo NextValue
        result.Add cellValueTrimmed, cellValueTrimmed
NextValue:
    Next cellValue

    On Error GoTo 0
End Function

Output

SGD
PHP
KRW
CNY
IDA
BGN
PDSS
CBBT
INPC
DBS
a

In case when the source range consists of areas get the values of all the areas first.

Public Function GetSourceValues(ByVal sourceRange As Range) As Collection
    Dim vals As VBA.Collection
    Dim area As Range
    Dim val As Variant
    Set vals = New VBA.Collection
    For Each area In sourceRange.Areas
        For Each val In area.Value
            If val <> "" Then _
                vals.Add val
        Next val
    Next area
    Set GetSourceValues = vals
End Function

Source type is now Collection but then all works the same:

Dim uniques As Collection
Dim source As Collection

Set source = GetSourceValues(ActiveSheet.Range("A2:F6").SpecialCells(xlCellTypeVisible))
Set uniques = GetUniqueValues(source)
like image 164
Daniel Dušek Avatar answered Nov 03 '22 19:11

Daniel Dušek


As of Excel 365, they have introduced the UNIQUE() Worksheet Function.

From Microsoft:

The UNIQUE function returns a list of unique values in a list or range.

=UNIQUE(Range,[by_col],[exactly_once])

This formula will output the unique values in multiple cells:

enter image description here

So entering the formula in A3, I wouldn't be able to use B3, or C3 as they contain some of the results.

So, for VBA you can just use Evaluate():

Dim uniques as Variant
uniques = Evalute("Unique(" & rng.Address & ",TRUE,FALSE)")

Which returns them in an array (Note: The index starts at 1 here, not 0).

like image 41
BruceWayne Avatar answered Nov 03 '22 21:11

BruceWayne