Count number of words in a table cell

[lynnnow]

Please see attached document for a sample.

The number of words in each cell in the second column need to be counted and the word count posted in the respective third column cell.

This is the code I wrote:


Sub TableWordCount()
Dim cl As Cell
With ActiveDocument.Tables(1)
For Each cl In .Columns(2).Cells
cl.Range.Select
Selection.MoveLeft wdCharacter, 1, wdExtend
If Selection.Text <> "Text" Then
.Columns(3).Cells(cl.RowIndex).Range.Text = Selection.Words.Count
End If
Next cl
End With
End Sub


Now the problem is that punctuation marks are also counted as words in the selected text. So if there is actually only one word with a "period", it is being counted as two.

I even tried replacing the punctuation marks in a string:


Sub TableWordCount()
Dim cl As Cell
Dim strFullString As String
Dim sltReplacedString As Selection
With ActiveDocument.Tables(1)
For Each cl In .Columns(2).Cells
cl.Range.Select
Selection.MoveLeft wdCharacter, 1, wdExtend
strFullString = Replace(Replace(Replace(Replace(Replace(Selection, ".", "", 1, , vbTextCompare), ",", "", 1, , vbTextCompare), ";", "", 1, , vbTextCompare), "!", "", 1, , vbTextCompare), "?", "", 1, , vbTextCompare)
Set sltReplacedString = strFullString '---- IT BUGS OUT HERE
If sltReplacedString.Text <> "Text" Then
.Columns(3).Cells(cl.RowIndex).Range.Text = sltReplacedString.Words.Count
End If
Next cl
End With
End Sub


but I cannot convert a string to a "Selection" type variable. Please help. Is there an alternative?

[lynnnow]

I tried something else, but it is imprecise:


Sub TableWordCount2()
Dim cl As Cell
Dim strFullString As String
Dim intWordCount As Integer
With ActiveDocument.Tables(1)
For Each cl In .Columns(2).Cells
cl.Range.Select
Selection.MoveLeft wdCharacter, 1, wdExtend
strFullString = Replace(Replace(Replace(Replace(Replace(Selection, ".", "", 1, , vbTextCompare), ",", "", 1, , vbTextCompare), ";", "", 1, , vbTextCompare), "!", "", 1, , vbTextCompare), "?", "", 1, , vbTextCompare)

intWordCount = Len(strFullString) - Len(Replace(strFullString, " ", "", 1, , vbTextCompare)) + 1
If Selection.Text <> "Text" Then
.Columns(3).Cells(cl.RowIndex).Range.Text = intWordCount
End If
Next cl
End With
End Sub

[lynnnow]

Got it correct...


Sub TableWordCount2()
Dim cl As Cell
Dim strFullString As String
Dim intWordCount As Integer
With ActiveDocument.Tables(1)
For Each cl In .Columns(2).Cells
cl.Range.Select
Selection.MoveLeft wdCharacter, 1, wdExtend
strFullString = Replace(Replace(Replace(Replace(Replace(Replace(Selection, ".", "", 1, , vbTextCompare), ",", "", 1, , vbTextCompare), ";", "", 1, , vbTextCompare), "!", "", 1, , vbTextCompare), "?", "", 1, , vbTextCompare), " ", " ", 1, , vbTextCompare)

intWordCount = Len(strFullString) - Len(Replace(strFullString, " ", "", 1, , vbTextCompare)) + 1
If Selection.Text <> "Text" Then
.Columns(3).Cells(cl.RowIndex).Range.Text = intWordCount
End If
Next cl
End With
End Sub