arrays count unique items?

[zrx1200]

Hello folks,

I have an array of say (s,e,se,sw,s,n,ne,ne,s,e,se) and would like the count of the unique items in that array using VBA. 7 in this example I believe.

Is this possible and how would it be done?

 

[Rick Rothstein]

I have an array of say (s,e,se,sw,s,n,ne,ne,s,e,se)...

Is that a VB array or a range of cells? Maybe you would like to share the code you have that shows how your are referencing the array?

 

[mohadin]

Hi
Try

Sub Macro1()
    Dim aa, u
    aa = Array("s", "e", "se", "sw", "s", "n", "ne", "ne", "s", "e", "se")
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 0
        For i = 1 To UBound(aa)
            .Item(aa(i)) = .Item(aa(i))
        Next
        u = .Count
        MsgBox "Unique counts" & vbLf & u
    End With
End Sub

BTW they are 6 unique items

 

[salim hasan]

Try this macro

Option Explicit


Sub How_Many_Unigues()
    Dim MY_Array, i%
    MY_Array = Array("s", "e", "se", "sw", "s", "n", "ne", "ne", "s", "e", "se")
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 0
        For i = LBound(MY_Array) To UBound(MY_Array)
           .Item(MY_Array(i)) = i + 1
        Next
        MsgBox "Unique counts" & vbLf & UBound(.keys) + 1
    End With
End Sub

 

[zrx1200]

Thanks guys for replies, worked great.

Rick, yes an vb array.

salim hasan and mohadin, your approaches are similar with slight differences to me, but could be significant but foreign to me at this time. I% is that a typo the %?

 

[Leith Ross]

Hello zrx1200,

Using the percent symbol after a number declares it as an Integer Type (signed 16 bit). It is the same as Dim i As Integer.

Here is a list of Type Declaration Characters used in VBA...

Variable Type	Character
String		$
Currency	@
Double		#
Single		!
LongLong	^ (64 bit Windows)
Long		&
Integer		%

 

[Peter_SSs]

Another way without needing to introduce the dictionary object.

Sub CountUnique()
  Dim myArray As Variant
  Dim i As Long, uCount As Long
  
  myArray = Array("s", "e", "se", "sw", "s", "n", "ne", "ne", "s", "e", "se")
  For i = LBound(myArray) To UBound(myArray)
    If Application.Match(myArray(i), myArray, 0) = i + 1 - LBound(myArray) Then uCount = uCount + 1
  Next i
  MsgBox "Unique count = " & uCount
End Sub

 

[salim hasan]

Another way without needing to introduce the dictionary object.

Sub CountUnique()
  Dim myArray As Variant
  Dim i As Long, uCount As Long
  
  myArray = Array("s", "e", "se", "sw", "s", "n", "ne", "ne", "s", "e", "se")
  For i = LBound(myArray) To UBound(myArray)
    If Application.Match(myArray(i), myArray, 0) = i + 1 - LBound(myArray) Then uCount = uCount + 1
  Next i
  MsgBox "Unique count = " & uCount
End Sub

What about this

Option Explicit


Sub CountUnique()
  Dim myArray As Variant
  Dim i As Long, Coll As New Collection
  myArray = Array("s", "e", "se", "sw", "s", "n", "ne", "ne", "s", "e", "se")
    For i = LBound(myArray) To UBound(myArray)
     On Error Resume Next
     Coll.Add myArray(i), myArray(i)
    Next i
  MsgBox "Unique count = " & Coll.Count
End Sub

 

[Peter_SSs]

What about this

That of course works too since a collection is basically like a dictionary only with a few less features, so that code is effectively pretty much identical to posts 3 and 4.
I'm not saying either dictionary or collection is the wrong way to proceed for this problem, but was simply offering what I see as a more direct method without the need for that extra 'object' whether it be a collection or a dictionary.

 

[Rick Rothstein]

I think Peter's code is better than the following, but I wanted to show that there is usually more than one way to code the solution to a problem... in this case, here is another way to do it without using the Dictionary or Collection objects...

Sub CountUnique()
  Dim i As Long, uCount As Long, Arr As Variant, Joined As String
  Arr = Array("s", "e", "SE", "sw", "s", "n", "ne", "ne", "s", "e", "se")
  Joined = "**" & Join(Arr, "**") & "**"
  For i = LBound(Arr) To UBound(Arr)
    If UBound(Split(Joined, "*" & Arr(i) & "*", , vbTextCompare)) >= 1 Then
      uCount = uCount + 1
      Joined = Replace(Joined, "*" & Arr(i) & "*", "**", , , vbTextCompare)
    End If
  Next i
  MsgBox "Unique count = " & uCount
End Sub