Hi,

Suppose in cell A1 I have a text --- "I had some bread in morning. I had
some eggs at night."

Is it possible to programmatically get a count of unique words in the above
string.
Like in column B the unique words are listed one word in each row in the
following manner..B1 -- "I"
B2 -- "I
B2 -- "had
B3 -- "some"
B4 -- "bread"
B5 -- "in"
B6 -- "morning"
B7 -- "eggs"
B8 -- "at"
B9 -- "night"

Actually I can use excel's text to columns feature ( using space as a
delimiter) but automating is a problem. Like I have 500 or so rows of data
and out of those rows I want to get count of unique words within those 500
rows ( basically a consolidated unique list..). Now, each row would be
having different number of words so, programmatically how would it be
implemented.

Please guide me if possible.

Regards,
Hari
India

You could get the text from the cell and use split() to create an
array of words. Exactly how you did this would depend on what you'd
consider as a "word".

You might want to use replace() on the string before splitting it to
replace newlines, tabs etc with spaces

'eg (untested)
dim sTxt as string, arrWords
sTxt=activesheet.range("A1").value
sTxt=replace(sTxt,vbTab," ")
sTxt=replace(sTxt,vbcrlf," ")
arrWords=split(sTxt," ")

Once you have the array you could loop through it and count the
occurences of the words: one way might be to use a dictionary object
where the word is the key and the value would be incremented each time
the word crops up. Then loop though the dictionary and write the
contents to column B.

tim






"Hari" wrote in message
...
Hi,

Suppose in cell A1 I have a text --- "I had some bread in morning. I
had
some eggs at night."

Is it possible to programmatically get a count of unique words in
the above
string.
Like in column B the unique words are listed one word in each row in
the
following manner..B1 -- "I"
B2 -- "I
B2 -- "had
B3 -- "some"
B4 -- "bread"
B5 -- "in"
B6 -- "morning"
B7 -- "eggs"
B8 -- "at"
B9 -- "night"

Actually I can use excel's text to columns feature ( using space as
a
delimiter) but automating is a problem. Like I have 500 or so rows
of data
and out of those rows I want to get count of unique words within
those 500
rows ( basically a consolidated unique list..). Now, each row would
be
having different number of words so, programmatically how would it
be
implemented.

Please guide me if possible.

Regards,
Hari
India

Try this. Requires a reference to the Scripting runtime library.

Tim.


Sub tester()
ActiveSheet.Range("B1").Value =
CountWords(ActiveSheet.Range("A1").Value)
End Sub

Function CountWords(sText As String) As String

Dim x As Integer
Dim arrWords As Variant
Dim arrReplace As Variant
Dim oDict As New Scripting.Dictionary
Dim tmp As String
Dim k As Variant
Dim sReturn As String

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

arrWords = Split(sText, " ")
oDict.CompareMode = TextCompare 'case-insensitive
For x = LBound(arrWords) To UBound(arrWords)
tmp = Trim(arrWords(x))
If tmp < "" Then
oDict(tmp) = IIf(oDict.Exists(tmp), oDict(tmp) + 1, 1)
End If
Next x

sReturn = ""
For Each k In oDict.Keys
sReturn = sReturn & "{" & k & "} : " & oDict(k) & Chr(10)
Next k

CountWords = sReturn
End Function

Tim.


"Hari" wrote in message
...
Hi,

Suppose in cell A1 I have a text --- "I had some bread in morning.
I had
some eggs at night."

Is it possible to programmatically get a count of unique words in
the above
string.
Like in column B the unique words are listed one word in each row
in the
following manner..B1 -- "I"
B2 -- "I
B2 -- "had
B3 -- "some"
B4 -- "bread"
B5 -- "in"
B6 -- "morning"
B7 -- "eggs"
B8 -- "at"
B9 -- "night"

Actually I can use excel's text to columns feature ( using space as
a
delimiter) but automating is a problem. Like I have 500 or so rows
of data
and out of those rows I want to get count of unique words within
those 500
rows ( basically a consolidated unique list..). Now, each row would
be
having different number of words so, programmatically how would it
be
implemented.

Please guide me if possible.

Regards,
Hari
India

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


I want to know if it is possible to ..

a) To have a consolidated count of words in both the rows. That is the above
result to combine the words in both rows 1 and 2 for giving a total result.
b) Is it is possible to have the count of words listed in different rows
rather than within a single cell (as per help you have used a chr(10) for
linefeed character). Accordingly have the counts in Column C for the
corresponding unique word.

For example for the above example with 2 rows, I visualise the following
result :-

Column -- A
B C
Row 1 I have measles. I also have TB.
I 3
2 I want to go to Paris in order to cure my TB.
Have 2
3
Measles 2
4
also 1
5
TB 2
6
want 1
7
to 3
8
go 1
9
Paris 1
10
in 1
11
order 1
12
cure 1
13
my 1


Actually why am requesting for the above way is I want to analyse count of
unique words across 500 rows or so and a consolidated list would help me a
lot.
-
Regards,
Hari
India

"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Try this. Requires a reference to the Scripting runtime library.

Tim.


Sub tester()
ActiveSheet.Range("B1").Value =
CountWords(ActiveSheet.Range("A1").Value)
End Sub

Function CountWords(sText As String) As String

Dim x As Integer
Dim arrWords As Variant
Dim arrReplace As Variant
Dim oDict As New Scripting.Dictionary
Dim tmp As String
Dim k As Variant
Dim sReturn As String

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

arrWords = Split(sText, " ")
oDict.CompareMode = TextCompare 'case-insensitive
For x = LBound(arrWords) To UBound(arrWords)
tmp = Trim(arrWords(x))
If tmp < "" Then
oDict(tmp) = IIf(oDict.Exists(tmp), oDict(tmp) + 1, 1)
End If
Next x

sReturn = ""
For Each k In oDict.Keys
sReturn = sReturn & "{" & k & "} : " & oDict(k) & Chr(10)
Next k

CountWords = sReturn
End Function

Tim.


"Hari" wrote in message
...
Hi,

Suppose in cell A1 I have a text --- "I had some bread in morning.
I had
some eggs at night."

Is it possible to programmatically get a count of unique words in
the above
string.
Like in column B the unique words are listed one word in each row
in the
following manner..B1 -- "I"
B2 -- "I
B2 -- "had
B3 -- "some"
B4 -- "bread"
B5 -- "in"
B6 -- "morning"
B7 -- "eggs"
B8 -- "at"
B9 -- "night"

Actually I can use excel's text to columns feature ( using space as
a
delimiter) but automating is a problem. Like I have 500 or so rows
of data
and out of those rows I want to get count of unique words within
those 500
rows ( basically a consolidated unique list..). Now, each row would
be
having different number of words so, programmatically how would it
be
implemented.

Please guide me if possible.

Regards,
Hari
India










--
Regards,
Hari
India
"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Try this. Requires a reference to the Scripting runtime library.

Tim.


Sub tester()
ActiveSheet.Range("B1").Value =
CountWords(ActiveSheet.Range("A1").Value)
End Sub

Function CountWords(sText As String) As String

Dim x As Integer
Dim arrWords As Variant
Dim arrReplace As Variant
Dim oDict As New Scripting.Dictionary
Dim tmp As String
Dim k As Variant
Dim sReturn As String

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

arrWords = Split(sText, " ")
oDict.CompareMode = TextCompare 'case-insensitive
For x = LBound(arrWords) To UBound(arrWords)
tmp = Trim(arrWords(x))
If tmp < "" Then
oDict(tmp) = IIf(oDict.Exists(tmp), oDict(tmp) + 1, 1)
End If
Next x

sReturn = ""
For Each k In oDict.Keys
sReturn = sReturn & "{" & k & "} : " & oDict(k) & Chr(10)
Next k

CountWords = sReturn
End Function

Tim.


"Hari" wrote in message
...
Hi,

Suppose in cell A1 I have a text --- "I had some bread in morning.
I had
some eggs at night."

Is it possible to programmatically get a count of unique words in
the above
string.
Like in column B the unique words are listed one word in each row
in the
following manner..B1 -- "I"
B2 -- "I
B2 -- "had
B3 -- "some"
B4 -- "bread"
B5 -- "in"
B6 -- "morning"
B7 -- "eggs"
B8 -- "at"
B9 -- "night"

Actually I can use excel's text to columns feature ( using space as
a
delimiter) but automating is a problem. Like I have 500 or so rows
of data
and out of those rows I want to get count of unique words within
those 500
rows ( basically a consolidated unique list..). Now, each row would
be
having different number of words so, programmatically how would it
be
implemented.

Please guide me if possible.

Regards,
Hari
India

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

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

Tim,

Is it possible to select a column vs a specific cell? I ran your program
below and it worked great. However, I need to run the program against a very
large amount of cells in column A. Is there a way to perform this task
without typing in each cell?(see example) I thought I could type a range
AddWordCount ActiveSheet.Range("A1:A1000") but I receive an error.

example:
AddWordCount ActiveSheet.Range("A1").Value
AddWordCount ActiveSheet.Range("A2").Value
AddWordCount ActiveSheet.Range("A3").Value
AddWordCount ActiveSheet.Range("A4").Value

Thank you in advance for any assistance you can provide.

Sincerley,

Todd Rein


"Tim Williams" wrote:

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

Hi Hari,

You could use a worksheet formula:

=SUMPRODUCT((ref<"")*(LEN(TRIM(ref))+1-LEN(SUBSTITUTE(ref," ",""))))

Regards
Peter T

"Hari" wrote in message
...
Hi,

Suppose in cell A1 I have a text --- "I had some bread in morning. I had
some eggs at night."

Is it possible to programmatically get a count of unique words in the
above
string.
Like in column B the unique words are listed one word in each row in the
following manner..B1 -- "I"
B2 -- "I
B2 -- "had
B3 -- "some"
B4 -- "bread"
B5 -- "in"
B6 -- "morning"
B7 -- "eggs"
B8 -- "at"
B9 -- "night"

Actually I can use excel's text to columns feature ( using space as a
delimiter) but automating is a problem. Like I have 500 or so rows of data
and out of those rows I want to get count of unique words within those 500
rows ( basically a consolidated unique list..). Now, each row would be
having different number of words so, programmatically how would it be
implemented.

Please guide me if possible.

Regards,
Hari
India

You could use a worksheet formula:

=SUMPRODUCT((ref<"")*(LEN(TRIM(ref))+1-LEN(SUBSTITUTE(ref," ",""))))

Regards
Peter T

Ignore - I totally misread "unique"
Peter T

Hi Peter,

No problem.

The fact that you people are out there helping problem posers ,gladdens me a
lot.

--
Thanks a lot,
Hari
India

Hi Hari,

Thanks for that, maybe it will come in handy as a "total" word count!

Regards,
Peter T

Hi Peter,

No problem.

The fact that you people are out there helping problem posers ,gladdens me
a
lot.

--
Thanks a lot,
Hari
India