Excel VBA Code Instead of SumIf Array Formula for Unique Values

Hello Chris,

Sorry, I misunderstood what you wanted. This workbook produces the output you showed in the picture. The new code is shown below and has been added to the attached workbook.

Sub Macro2()

  ' Get sums for unique products in each account.
  
    Dim Account As Variant
    Dim Data    As Variant
    Dim DstWks  As Worksheet
    Dim Cnt     As Long
    Dim LastRow As Long
    Dim Products As String
    Dim Rng     As Range
    Dim SrcWks  As Worksheet
    Dim Sums    As Object
   
        Set SrcWks = Worksheets("Sheet1")
        Set DstWks = Worksheets("Sheet2")
        
        Set Rng = SrcWks.Range("A2:B2")
        LastRow = SrcWks.Cells(Rows.Count, Rng.Column).End(xlUp).Row
        If LastRow < Rng.Row Then Exit Sub Else Set Rng = Rng.Resize(LastRow - Rng.Row + 1, 2)
        
            Set Sums = CreateObject("Scripting.Dictionary")
            Sums.CompareMode = vbCompare
            
            Data = Rng.Value
            
            For i = 1 To LastRow - Rng.Row + 1
                Account = Data(i, 2)
                If Not Sums.Exists(Account) Then
                    Products = Data(i, 1)
                    Sums.Add Account, Products
                Else
                    Products = Sums(Account)
                    Cnt = InStr(1, Products, Data(i, 1))
                    If Cnt = 0 Then
                        Sums(Account) = Products & "|" & Data(i, 1)
                    End If
                End If
            Next i
            
            Cnt = 0
            ReDim Data(1 To Sums.Count, 1 To 2)
            
            For Each Key In Sums.Keys
                Cnt = Cnt + 1
                Data(Cnt, 1) = Key
                Data(Cnt, 2) = UBound(Split(Sums(Key), "|")) + 1
            Next Key
                
        Application.ScreenUpdating = False
            DstWks.UsedRange.Offset(1, 0).ClearContents
            DstWks.Cells(Rng.Row, Rng.Column).Resize(Cnt, 2).Value = Data
        Application.ScreenUpdating = True
        
End Sub