Excel - Counting unique values ​​matching IDs optimized for 100,000+ cases

Here is a VBA routine that should run quickly for this number of records. We create a class module (custom object) that consists of a collection (Dictionary) of colors associated with each identifier and a count of that color. (There isn't really a need for counting, but it's trivial to add it if you want it for some other purpose, and also as a demonstration of what can be done.)

We then output the results in the adjacent column as shown in the screenshot. Results can be displayed elsewhere, even on a different sheet, with minor code changes.

Be sure to read the notes at the beginning of the modules for important information and proper configuration.

Class module

Option Explicit
'RENAME this module:  cID

Private pID As String
Private pColor As String
Private pColors As Dictionary

Public Property Get ID() As String
    ID = pID
End Property
Public Property Let ID(Value As String)
    pID = Value
End Property

Public Property Get Color() As String
    Color = pColor
End Property
Public Property Let Color(Value As String)
    pColor = Value
End Property

Public Property Get Colors() As Dictionary
    Set Colors = pColors
End Property
Public Function ADDColor(Value As String)
    'Might as well also count # of times this color assigned
    If Not pColors.Exists(Value) Then
        pColors.Add Key:=Value, Item:=1
    Else
        pColors(Value) = pColors(Value) + 1
    End If
End Function

Private Sub Class_Initialize()
    Set pColors = New Dictionary
End Sub

      

        
        
        
      

    

Regular module

EDIT (edited to exclude counting for blank lines)

Option Explicit
'Set reference to Microsoft Scripting Runtime (Tools/References)

Sub IDColorCount()
    Dim cID As cID, dID As Dictionary
    Dim wsData As Worksheet, rData As Range
    Dim vData As Variant, vRes As Variant
    Dim I As Long

'Set the data worksheet and range
'Read the data into an array for faster calculations
Set wsData = Worksheets("sheet1")
With wsData
    Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
    vData = rData
End With

'Go through the data and collect the information
Set dID = New Dictionary
For I = 2 To UBound(vData, 1)
  If Not vData(I, 1) = "" Then
    Set cID = New cID
    With cID
        .ID = vData(I, 1)
        .Color = vData(I, 2)
        .ADDColor .Color

        If Not dID.Exists(.ID) Then
            dID.Add Key:=.ID, Item:=cID
        Else
            dID(.ID).ADDColor .Color
        End If
    End With
  End If
Next I

'Size the results array
ReDim vRes(1 To UBound(vData), 1 To 1)
vRes(1, 1) = "Count"
For I = 2 To UBound(vData, 1)
    If Not vData(I, 1) = "" Then _
        vRes(I, 1) = dID(CStr(vData(I, 1))).Colors.Count
Next I

'The results can  be written anyplace
With rData.Offset(0, 2).Resize(columnsize:=1)
    .EntireColumn.Clear
    .Value = vRes
End With

End Sub