Wordcount in tables

[John Svendsen]

Hi all:
I've written a macro to count non-space characters and words specifically
for Word tables; but it seems that computestatistics does not work for
tables? Could've I done something wrong or is this so? Please see code
below.
TIA, js

--------------------------------------------------------------
Sub Z_TABLEComputeStatistics()
Dim tS, tE, TotNSChar As Long, TotNSCharS As Long, TotWrd As Long, TotWrdS
As Long
Dim NTabMax As Long, NTab As Long, NRow As Long, NRowMax As Long, NCol As
Long, NColMax As Long
Dim R As Range, Txt As String
tS = Time: TotNSChar = 0: TotNSCharS = 0: TotWrd = 0: TotWrdS = 0
NTabMax = ActiveDocument.Tables.Count
For NTab = 1 To NTabMax
NColMax = ActiveDocument.Tables(NTab).Columns.Count
NRowMax = ActiveDocument.Tables(NTab).Rows.Count
For NCol = NColMax To NColMax
For NRow = 1 To NRowMax
ActiveDocument.Tables(NTab).Cell(NRow, NCol).Select
Set R = ActiveDocument.Tables(NTab).Cell(NRow, NCol).Range
Txt = Left(R.Text, Len(R) - 2)
Txt = Replace(Txt, " ", ""): Txt = Replace(Txt, Chr(160), "")
If ActiveDocument.Tables(NTab).Cell(NRow,
NCol).Shading.BackgroundPatternColor = wdColorAutomatic And _
ActiveDocument.Tables(NTab).Cell(NRow,
NCol).Shading.ForegroundPatternColor = wdColorAutomatic Then
'If Selection.Shading.BackgroundPatternColor = wdColorAutomatic Then
TotWrd = TotWrd + R.ComputeStatistics(Statistic:=wdStatisticWords)
'*DEBUG* MsgBox ActiveDocument.Tables(NTab).Cell(NRow,
NCol).Range.ComputeStatistics(wdStatisticWords)
TotNSChar = TotNSChar + Len(Txt)
Else
TotWrdS = TotWrdS + R.ComputeStatistics(Statistic:=wdStatisticWords)
'*DEBUG* MsgBox ActiveDocument.Tables(NTab).Cell(NRow,
NCol).Range.ComputeStatistics(wdStatisticWords)
TotNSCharS = TotNSCharS + Len(Txt)
End If
Next NRow
Next NCol
Next NTab
tE = Time
MsgBox ("No-space Character Count of Last Column In Tables:" & vbCrLf & _
"Total NSCharacters in NON-shaded Cells =" & TotNSChar & vbCrLf & _
"Total NSCharacters in SHADED Cells =" & TotNSCharS & vbCrLf & _
"Grand-Total NSCharacters in Last Column=" & TotNSChar + TotNSCharS)
& vbCrLf & vbCrLf & _
("Word Count of Last Column In Tables:" & vbCrLf & _
"Total Words in NON-shaded Cells =" & TotWrd & vbCrLf & _
"Total Words in SHADED Cells =" & TotWrdS & vbCrLf & _
"Grand-Total Words in Last Column=" & TotWrd + TotWrdS)
MsgBox "Start=" & tS & " | End=" & tE & " | Lap=" & Format(tE - tS,
"hh:mm:ss")
End Sub

 

[Helmut Weber]

Hi John,

apart from that you posted too much code
instead of clearing it before
from all that was tested and is working,
it is working alright here and now.

No problem with something like:

Sub Test04()
With ActiveDocument.Tables(1).Range
MsgBox .ComputeStatistics(wdStatisticWords)
End With
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[John Svendsen]

Hi Helmut: thanks for your reply.

Please try:

Sub Test04()
With ActiveDocument.Tables(1).Cell(1, 1).Range
MsgBox .ComputeStatistics(wdStatisticWords)
End With
End Sub

Tks, JS

 

[John Svendsen]

P.S. I'm using Office 2003 on XP Home

 

[Helmut Weber]

Hi John,

Text in cell(1,1) is "Red Brown"

Sub Test04()
With ActiveDocument.Tables(1).Cell(1, 1).Range
MsgBox .ComputeStatistics(wdStatisticWords)
End With
End Sub

returns 0 (zero) :-(

But as selection is often faster in tables anyway,
you may google for my decent name and "selection table speed",
or similar, if you like.

I'd recommend something like that:

Sub Test04a()
With ActiveDocument.Tables(1).Cell(1, 1).Range
..Select
Selection.End = Selection.End - 1
MsgBox Selection.Range.ComputeStatistics(wdStatisticWords) ' 2
End With
End Sub

HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[John Svendsen]

Hi Helmut,
Please excuse my belated reply - thanks for your suggestion, it works like a
charm
Danke, JS

 

[Helmut Weber]

accepted,

thx for the feedback

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"