Count words in a cell & output number of occurences of each word in adjecent cell.

Hi Experts,

I am looking for a code which can count words in a cell and return output as number of occurences of each word in the adjecent cell.

Eg:
Cell A1 contains : a, a, b, c, d, b

After executing the code I need output in B1 as:
a(2), b(2), c(1), d(1)

I have found code on internet & have modified the same to my requierment. With below code I am getting output in different rows instead of getting the same on one single cell.

Sub CountString()
    Dim vArray As Variant
    Dim lLoop As Long
     
    With CreateObject("Scripting.Dictionary")
            vArray = Split(ActiveCell.Value, ", ")
            For lLoop = LBound(vArray) To UBound(vArray)
                If Not .exists(vArray(lLoop)) Then
                    .Add vArray(lLoop), 1
                Else
                    .Item(vArray(lLoop)) = .Item(vArray(lLoop)) + 1
                End If
            Next lLoop
        Range("B1").Resize(.Count).Value = Application.Transpose(.keys)
        Range("C1").Resize(.Count).Value = Application.Transpose(.items)
    End With
End Sub

Please help.

Regards
kprasad