Thread: Count Duplicates from VBA Array?

Hi,

You could consider using a dictionary object to do this. For example:

Sub foo()

    Dim sarrCodes(0 To 5) As String
    Dim a As Long
    Dim vKey As Variant
    Dim objDic As Scripting.Dictionary
    
    sarrCodes(0) = "ISB2-01"
    sarrCodes(1) = "ISB2-01"
    sarrCodes(2) = "ISB2-02"
    sarrCodes(3) = "ISB2-02"
    sarrCodes(4) = "ISB2-02"
    sarrCodes(5) = "ISB2-03"
    
    Set objDic = CreateObject("Scripting.Dictionary")
    
    For a = LBound(sarrCodes) To UBound(sarrCodes)
        If objDic.Exists(sarrCodes(a)) Then
            objDic.Item(sarrCodes(a)) = objDic.Item(sarrCodes(a)) + 1
        Else
            objDic.Add sarrCodes(a), 1
        End If
    Next a
    
    For Each vKey In objDic.Keys
        Debug.Print vKey; objDic.Item(vKey)
    Next vKey
    
End Sub

Results in immediate window:

ISB2-01 2 
ISB2-02 3 
ISB2-03 1

This example uses early binding so it requires a reference to the Microsoft Scripting Runtime library.

No, not really. Here's a late bound version if you don't want to add the reference...

Sub foo()
    Dim sarrCodes(0 To 5) As String
    Dim a As Long
    Dim vKey As Variant
    Dim objDic As Object   
 
    sarrCodes(0) = "ISB2-01"
    sarrCodes(1) = "ISB2-01"
    sarrCodes(2) = "ISB2-02"
    sarrCodes(3) = "ISB2-02"
    sarrCodes(4) = "ISB2-02"
    sarrCodes(5) = "ISB2-03"
    
    Set objDic = CreateObject("Scripting.Dictionary")
    
    For a = LBound(sarrCodes) To UBound(sarrCodes)
        If objDic.Exists(sarrCodes(a)) Then
            objDic.Item(sarrCodes(a)) = objDic.Item(sarrCodes(a)) + 1
        Else
            objDic.Add sarrCodes(a), 1
        End If
    Next a
    
    For Each vKey In objDic.Keys
        Debug.Print vKey; objDic.Item(vKey)
    Next vKey
    
End Sub