Below is the Code
Sub Separator2()
Sheets("sheet1").Columns("B").ClearContents
Sheets("sheet1").Columns("C").ClearContents
Dim TextStrng As String
Dim Result() As String
TextStrng = Cells(1, 1).Value
TextStrng = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(TextStrng, ",", ""), ".", ""), ":", ""), "the ", " "), "and ", " "), " to ", " "), " of ", " "), " a ", " "), "that ", " "), " in ", " "), "said ", " "), " he ", " "), " she ", " "), " on ", " "), " for ", " "), " had ", " "), " was ", " "), " not ", " "), vbLf, "")
Result = Split(TextStrng, " ")
For i = LBound(Result()) To UBound(Result())
b = i + 1
Cells(b, 2).Value = Result(i)
Next i
Sheets("Sheet1").Columns("B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("sheet1").Columns("C"), Unique:=True
For iCounter = 1 To WorksheetFunction.CountA(Columns(3))
Range("D" & iCounter).Value = WorksheetFunction.CountIf(Range("B:B"), Cells(iCounter, 3).Value)
Next iCounter
Worksheets("Sheet1").Sort.SortFields.Clear
Range("C:D").Sort Key1:=Range("D1"), Header:=xlNo, Order1:=xlDescending
num2 = WorksheetFunction.CountA(Columns(4))
Range("C" & 21 & ":" & "D" & num2).ClearContents
End Sub
