Hi
try this macro
it will search the range InputRange, list unique values in a column begining at cell OutputCell and list the number of occurrences in the cell to the right of that. You will need to set the ranges according to your data
Sub UniqueList()
'returns all the unique words in range InputRange in a list in a column begining at OutputCell, with the number of occurrences to the right
Dim InputRange As Range, OutputCell As Range, cCell As Range, WordArr As Variant, n As Long, z As Long, wrdZ As Variant, x As Long, Addword As Boolean, WordNumz
Set InputRange = Range("A1:A14")
Set OutputCell = Range("D1") 'cell to beging list of unique words
WordArr = Array()
WordNumz = Array()
n = 0
For Each cCell In InputRange.Cells
wrdZ = Split(cCell.Value, ",")
For z = LBound(wrdZ) To UBound(wrdZ)
Addword = True
For x = LBound(WordArr) To UBound(WordArr)
If Trim(LCase(wrdZ(z))) = Trim(LCase(WordArr(x))) Then
Addword = False
WordNumz(x) = 1 + WordNumz(x)
End If
Next x
If Addword = True Then
ReDim Preserve WordArr(n)
ReDim Preserve WordNumz(n)
WordArr(n) = Trim(wrdZ(z))
WordNumz(n) = 1
n = n + 1
End If
Next z
Next cCell
For x = LBound(WordArr) To UBound(WordArr)
OutputCell.Offset(x, 0).Value = Trim(WordArr(x))
OutputCell.Offset(x, 1).Value = WordNumz(x)
Next x
End Sub
Bookmarks