Hi Tim,

Thanx a ton for posting the codes. Just to tell you of why I needed it, I
analyse Market Research data and I needed count of unique words to analyse
open ended responses.
For example I am studying/tracking the usage of Software Development tools.
I ran your code on the following 8 responses (8 rows of data).

hot dog pro
As 400 RPG
adobe photo workshop
microfocus emulators
html
ibm web sphere
vx works
powerhouse

The results Im getting is :-

hot 1
dog 1
pro 1
As 1
400 1
RPG 1
adobe 1
photo 1
workshop 2
microfocus 1
emulators 1
html 1
ibm 1
web 1
sphere 1
vx 1
powerhouse 1

Whats happening is that the SUB is treating "works" which is in the 7th row
same as "workshop" which is in the 3rd row. Consequently the count of
"workshop" is being shown as 2 while "works" doesnt appear in the result.
Please tell me whether it would be possible to modify the code in order to
get the count for "workshop" as 1 and count of "works" as 1.

(Just in case if u have a doubt on the futility of analysing, in a 'faulty'
manner, by counting unique words where separating doesnt make sense - Like
"adobe photo workshop" being one tool and separating these 3 - I plan to
tackle that by running your sub first to get the initial stage 'frequency'
and then I will bind those individual responses "adobe photo workshop" in to
"AdobePhotoWorkshop". I will not bind those rows where 2 software tools are
mentioned in a single row.)

Regards,
Hari
India

"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Hari,

Try this - seems to work OK but you should test it before using.

Regards
Tim


Option Explicit

Sub tester()
AddWordCount ActiveSheet.Range("A1").Value
AddWordCount ActiveSheet.Range("A2").Value
End Sub

Sub AddWordCount(sText As String)

Const COL_WORDS As Integer = 2
Const COL_COUNTS As Integer = 3
Const ROW_START As Integer = 1
Const MAX_ROWS As Integer = 10000

Dim x As Integer
Dim arrWords As Variant
Dim arrReplace As Variant
Dim tmp As String
Dim lRow As Long
Dim lLastRow As Long
Dim rngSrch As Range, rngWord As Range

'find extent of current count
lLastRow = ActiveSheet.Cells(MAX_ROWS, COL_WORDS).End(xlUp).Row
If lLastRow = 0 Then lLastRow = 1
Set rngSrch = Range(ActiveSheet.Cells(ROW_START, COL_WORDS), _
ActiveSheet.Cells(lLastRow, COL_WORDS))

arrReplace = Array(vbTab, ":", ";", ".", ",", _
"""", Chr(10), Chr(13))
For x = LBound(arrReplace) To UBound(arrReplace)
sText = Replace(sText, arrReplace(x), " ")
Next x

arrWords = Split(sText, " ")

For x = LBound(arrWords) To UBound(arrWords)
tmp = Trim(arrWords(x))
If tmp < "" Then

On Error Resume Next
Set rngWord = rngSrch.Find(What:=tmp, MatchCase:=False)
On Error GoTo 0

If rngWord Is Nothing Then
lLastRow = lLastRow + 1
Set rngSrch = rngSrch.Resize(rngSrch.Rows.Count + 1, 1)
With ActiveSheet.Cells(lLastRow, COL_WORDS)
.Value = tmp
.Offset(0, 1).Value = 1
End With
Else
rngWord.Offset(0, 1).Value = rngWord.Offset(0, 1).Value +
1
End If

End If
Next x


End Sub

"Hari" wrote in message
...
Hi Tim,

(Im sorry, my computer has some bios/date problem, so Im Re-Posting
the
below message after correcting the date/time setting)

Thanks a lot for your code.

I have a small change if possible.

Presently if In A1 I have --- I have measles. I also have TB.
and if in A2 I have --- I want to go to Paris in order to cure my
TB.
Then in B1I get the below result

{I} : 2
{have} : 2
{measles} : 1
{also} : 1
{TB} : 1

and for getting the below result in B2 (by running your sub again by
changing the address)

{I} : 1
{want} : 1
{to} : 3
{go} : 1
{Paris} : 1
{in} : 1
{order} : 1
{cure} : 1
{my} : 1
{TB} : 1