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