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

Sub test()
    Dim e, txt As String
    If ActiveCell.Value = "" Then Exit Sub
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each e In Split(ActiveCell.Value, ",")
            .Item(Trim$(e)) = .Item(Trim$(e)) + 1
        Next
        For Each e In .keys
            txt = txt & ", " & e & "(" & .Item(e) & ")"
        Next
    End With
    ActiveCell(, 2).Value = Mid$(txt, 3)
End Sub

Wow!!! Thanks jindon.... It works really well.

Thanks Again,

kprasad