arrays count unique items?

zrx1200

Well-known Member
Joined
Apr 14, 2010
Messages
622
Office Version
  1. 2019
Platform
  1. Windows
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?
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi
Try
Code:
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
 
Last edited:
Upvote 0
Try this macro
Code:
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
 
Upvote 0
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 %?
 
Upvote 0
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...

Code:
Variable Type	Character
String		$
Currency	@
Double		#
Single		!
LongLong	^ (64 bit Windows)
Long		&
Integer		%
 
Last edited:
Upvote 0
Another way without needing to introduce the dictionary object.

Code:
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
 
Upvote 0
Another way without needing to introduce the dictionary object.

Code:
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
Code:
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
 
Upvote 0
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. :)
 
Upvote 0
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...
Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top