counting unique entries in an array

[troelsi]

Hello Experts

Is it possible to use some sort of a worksheetfunction to count the number of unique entries in a array?

Type xt
varenr As String
recept As String
tid As Variant
linie As String
AkumTid As Single
End Type

Dim x() As xt

I need to count the unique entries of x().recept.
what is the best/fastest way to do this. It doesn't have to involve a worksheetfunction.

[troelsi]

Came up with ths:


For i = LBound(x) To UBound(x)
TempInt = 0
If i > 1 Then
For j = i - 1 To LBound(x) Step -1
If x(i).recept = x(j).recept Then
TempInt = 1
Exit For
End If
Next j
End If
If TempInt = 0 Then
forekomster = forekomster + 1
End If
Next i

[tstav]

Hi troelsi,
I went over the code that you came up with, and revamped it a bit, adding some validation checks and some other stuff.
If you haven't already come up with a final solution, I hope this will help you get through.


Sub UniqueValuesCount(ByVal X as Variant)
'X is your Array
Dim lngUniqueItemsCount, lngItemIndex, lngCompareIndex As Long

'Check that the Array contains values,
'else abort (or do whatever you please)
lngUniqueItemsCount = UBound(X) + 1
If Err Then
Err.Clear
MsgBox "Array X is empty"
Exit Sub
End If

'Since the Array contains at least one item, initialize the
'number of unique items
lngUniqueItemsCount = 1

'Check each item with all the "before this item" items
For lngItemIndex = LBound(X) + 1 To UBound(X)

For lngCompareIndex = lngItemIndex - 1 To LBound(X) Step -1
If X(lngItemIndex).recept = X(lngCompareIndex).recept Then
Exit For
End If
Next 'lngCompareIndex

'If none matched it, increase the unique items count
If lngCompareIndex < LBound(X) Then
lngUniqueItemsCount = lngUniqueItemsCount + 1
End If
Next 'lngItemIndex

MsgBox "Number of unique items is: " & lngUniqueItemsCount
End Sub

[mdmackillop]

Hi tstav,
If you select code and click the VBA button, it will be formatted as shown, making it more readable.
Regards
MD

[tstav]

If you select code and click the VBA button, it will be formatted as shown
Thank you so much MD,
I joined the forum today (and mind you, this is the first forum I've ever joined). No matter how hard I tried to find out how you guys "colored and indented" your code, I couldn't.
Thank you again. Have a nice day!

[mdmackillop]

You can use a dictionary object to get unique items. This is for a Range, but can be adapted to analyse an array. The object will not allow repeating keys and so stores unique items only.

Option Explicit
Sub GetUnique()
Dim d, rng As Range, c As Range, arr, a 'Create variables
Dim msg As String
Set d = CreateObject("Scripting.Dictionary")
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
On Error Resume Next
For Each c In rng
d.Add c.Text, c.Text 'add keys and items
Next
arr = d.items
MsgBox UBound(arr) + 1 & " unique items"
'Do something with items
For Each a In arr
msg = msg & a & vbCr
Next
MsgBox msg
End Sub

[troelsi]

Thanks for your reply.

I think I prefer tstav's version. I'm just not sure how a dictionary object works, so it would be easier for me to go along with tstav's version.

Thanks!

[tstav]

I'm glad that I have helped Troelsi!
Still, I feel that mdmackillop deserves our very special thanks for he has shown us a road never before travelled (at least by me).
I was not aware of the existence of a Dictionary Object.
Now that I have read about it and found out how it can be used, I see that it may come pretty handy in various situations.
Thanks again MD!
Best regards Troelsi!

[troelsi]

I would like to make a function that I can use to count unique items in every array I like. However I do have some problems with that.
My code is exactly as suggested by tsav except for the first line:

Function UniqueValuesCount(x() As xt)


x is a userdefined array, but I would also like to count the unique items in a "normal" array:


ReDim arr(1 To r) As Variant


I realize that I also have to pass the item that has to be counted in the function, but for now I don't even know how to pass the array. I get this error:"type mismatch:array or user-defined type expected"
I've also tryed this:

Function UniqueValuesCount(x() As variant)

But it gives me the same error.

Can somebody please explain to me what I don't seem to understand?

Thank you

Troelsi

[Bob Phillips]

Functioning it



Sub Macro1()
Dim myArray As Variant

myArray = Array("a", "b", "c", "a")
MsgBox "Number of unique items is: " & UniqueValuesCount(myArray)

End Sub


Function UniqueValuesCount(ByVal X As Variant) As Long
'X is your Array
Dim lngUniqueItemsCount As Long
Dim lngItemIndex As Long
Dim lngCompareIndex As Long

'Check that the Array contains values,
'else abort (or do whatever you please)
lngUniqueItemsCount = UBound(X) + 1
If Not Err Then
Err.Clear

'Since the Array contains at least one item, initialize the
'number of unique items
lngUniqueItemsCount = 1

'Check each item with all the "before this item" items
For lngItemIndex = LBound(X) + 1 To UBound(X)

For lngCompareIndex = lngItemIndex - 1 To LBound(X) Step -1
If X(lngItemIndex) = X(lngCompareIndex) Then
Exit For
End If
Next 'lngCompareIndex

'If none matched it, increase the unique items count
If lngCompareIndex < LBound(X) Then
lngUniqueItemsCount = lngUniqueItemsCount + 1
End If
Next 'lngItemIndex

UniqueValuesCount = lngUniqueItemsCount
End If
End Function

[troelsi]

Thanks for your reply XLD.
I tryed to use your function code with the following macro, but i get a compile error. It seems to be because I using a user defined type, but I'm not sure.
The code:


Option Explicit
Option Base 1
Type xt
recept As String
End Type

Sub Macro1()
Dim x(4) As xt
x(1).recept = "a"
x(2).recept = "b"
x(3).recept = "c"
x(4).recept = "a"
MsgBox "Number of unique items is: " & UniqueValuesCount(x)

End Sub


The compile error:
"Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late bound functions".

The thing is I would like the function to work both with user defined arrays and regular arrays if that's possible.

/Troelsi

[Bob Phillips]

I never use UDTs because of the rubbish implementation in VB/VBA. I would build a class every time.

[tstav]

Oops! this was sent by mistake, but it's the same as the following. It only misses the comments I added in the following post


Option Explicit
Option Base 1
Type xt
recept As String
End Type

Sub Macro1()
Dim X(4) As xt
X(1).recept = "a"
X(2).recept = "b"
X(3).recept = "c"
X(4).recept = "a"
'I
MsgBox "Number of unique items is: " & UniqueValuesCount(X())

End Sub
Function UniqueValuesCount(ByRef X() As xt) As Long
'X is your Array
Dim lngUniqueItemsCount As Long
Dim lngItemIndex As Long
Dim lngCompareIndex As Long

'Check that the Array contains values,
'else abort (or do whatever you please)
lngUniqueItemsCount = UBound(X) + 1
If Not Err Then
Err.Clear

'Since the Array contains at least one item, initialize the
'number of unique items
lngUniqueItemsCount = 1

'Check each item with all the "before this item" items
For lngItemIndex = LBound(X) + 1 To UBound(X)

For lngCompareIndex = lngItemIndex - 1 To LBound(X) Step -1
If X(lngItemIndex).recept = X(lngCompareIndex).recept Then
Exit For
End If
Next 'lngCompareIndex

'If none matched it, increase the unique items count
If lngCompareIndex < LBound(X) Then
lngUniqueItemsCount = lngUniqueItemsCount + 1
End If
Next 'lngItemIndex

UniqueValuesCount = lngUniqueItemsCount
End If
End Function

[tstav]

There you go troelsi!

Option Explicit
Option Base 1
Type xt
recept As String
End Type

Sub Macro1()
Dim X(4) As xt
X(1).recept = "a"
X(2).recept = "b"
X(3).recept = "c"
X(4).recept = "a"
'I changed the next line
MsgBox "Number of unique items is: " & UniqueValuesCount(X())

End Sub
'I also changed the next line
Function UniqueValuesCount(ByRef X() As xt) As Long
'X is your Array
Dim lngUniqueItemsCount As Long
Dim lngItemIndex As Long
Dim lngCompareIndex As Long

'Check that the Array contains values,
'else abort (or do whatever you please)
lngUniqueItemsCount = UBound(X) + 1
If Not Err Then
Err.Clear

'Since the Array contains at least one item, initialize the
'number of unique items
lngUniqueItemsCount = 1

'Check each item with all the "before this item" items
For lngItemIndex = LBound(X) + 1 To UBound(X)

For lngCompareIndex = lngItemIndex - 1 To LBound(X) Step -1
'I added .recept for it to work
If X(lngItemIndex).recept = X(lngCompareIndex).recept Then
Exit For
End If
Next 'lngCompareIndex

'If none matched it, increase the unique items count
If lngCompareIndex < LBound(X) Then
lngUniqueItemsCount = lngUniqueItemsCount + 1
End If
Next 'lngItemIndex

UniqueValuesCount = lngUniqueItemsCount
End If
End Function

[troelsi]

Thanks for your answers.

But it's not exactly what I'm looking for. I was wondering if it's possible to make a function that you can pass any array to (regardless of it's a user defined type or not), and then the function would count the unique entries in it.

Nb.: What is a class?

[tstav]

A User Defined Type is something WE create. It is not a string, or a variant or anything of the sort. It's a custom Type (like xt in your example).
When passing parameters to a function you have to declare them according to their type.
So, if a parameter is a variant you pass it as variant, if it's xt you pass it as xt.
I don't think you can use an all-purpose function. :dunno
If someone else knows different, please let us all know.

[Bob Phillips]

Thanks for your answers.

But it's not exactly what I'm looking for. I was wondering if it's possible to make a function that you can pass any array to (regardless of it's a user defined type or not), and then the function would count the unique entries in it.

So what makes a UDT unique, the first item, the second., all or what. Such a generic function doe snot exist ADAIK, you would have to create ne, which inevitably leads to having to reduce the genericism, limited to actual real word data types.


Nb.: What is a class?

A class is a custom object, so it would have properties for each of the elements of the UDT, and a collection class to contain ecah element (class).