CODEWITHSUNDEEP
vbaexcel
Student of the Digital World
Student of the Digital World

Reputation: 3041

Excel VBA - Formula Counting Unique Value error

I am trying to calculate the count of Unique values based on a condition.

For example,

For a value in column B, I am trying to count the Unique values in Column C through VBA.

I know how to do it using Excel formula - 

 =SUMPRODUCT((B2:B12<>"")*(A2:A12=32)/COUNTIF(B2:B12,B2:B12))

that value for 32 is dynamic - Programmatically I am calling them inside my vba code as Name

This is my code :

Application.WorksheetFunction.SumProduct((rng <> "") * (rng2 = Name) / CountIfs(rng, rng))

This is the sample data with the requirement

DATA

Alternatively, I Concatenated both the columns for keeping it simple and hoping to identify the Unique values which starts with name* method.

I don't know where I am going wrong. Kindly share your thoughts.

Upvotes: 0

Views: 471

Answers (2)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

You may try something like this...

Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
    If x(i, 1) = Lookup Then
        dict.Item(x(i, 1) & x(i, 2)) = ""
    End If
Next i
GetUniqueCount = dict.Count
End Function

Then you can use it like below...

=GetUniqueCount($A$2:$B$10,C2)

Where A2:B10 is the data range and C2 is the name criteria.

enter image description here

enter image description here

Upvotes: 1

Absinthe
Absinthe

Reputation: 3391

I'd put the values into an array, create a temporary 2nd array and only add values to this array if they are not already present, and then replace the original array. Then it's just a simple matter to sum the unique values:

Sub Unique

dim arr(10) as variant, x as variant
dim arr2() as variant

for x = 1 to 10 ' or whatever
   arr(x) = cells(x, 1) ' or whatever
next x

arr2 = UniqueValuesArray(arr)

' now write some code to count the unique values, you get the idea

End Sub

Function UniqueValuesArray(arr As Variant) As Variant()

Dim currentRow, arrpos As Long
Dim uniqueArray() As Variant
Dim x As Long

arrpos = 0
ReDim uniqueArray(arrpos)

For x = 0 To UBound(arr)
    If UBound(Filter(uniqueArray, arr(x))) = -1 Then
        ReDim Preserve uniqueArray(arrpos)
        uniqueArray(arrpos) = arr(x)
        arrpos = arrpos + 1
    End If
Next x

UniqueValuesArray = uniqueArray

End Function

Upvotes: 0

Related Questions