Counting-Macro for non-empty rows in a column

[Jean Laflèche]

Hello everybody,

I'm refered by Tisane, a French speeking Word MPV's, for help.

I make several merging-catalogs, from Excel 2000 to Word 2000. The results
are in a table, wich contains, sometime, many columns. As far, it's working
quite well.

I'm wandering if a macro could be possible and easealy done, to make appear
in the last row, the count of the non-empty rows of each column, wich
represents a different category. If so, could someone be kind enough to
help me to write it?

Example :

Column A Column B Column C
(MERGEFIELD A) (MERGEFIELD B) (MERGEFIELD C)
for Bar for Restaurant for Bar &
Restaurant

Joe Carol Jane
Yvonne Ann Charles
John
Carla
Debbie
______________________________________________________________________
2 go to Bar only 3 go to Restaurant only 4 go to Bar &
Restaurant TOTAL : 9 records

 

[Greg Maxey]

I don't understand your example, but if I understand the question you want
the total of cells containing data in each column put in the last row of
each column.

This assumes that there is no header row and a blank last row already exists
for the totals:

Sub Scratchmacro()
Dim oTbl As Word.Table
Dim i As Long
Dim j As Long
Dim pCount As Long
Set oTbl = Selection.Tables(1) 'Or ActiveDocument.Tables(?)"
For i = 1 To oTbl.Columns.Count
pCount = 0
For j = 1 To oTbl.Rows.Count
If j = oTbl.Rows.Count Then oTbl.Cell(j, i).Range.Text = pCount
If Len(oTbl.Cell(j, i).Range.Text) > 2 Then
pCount = pCount + 1
End If
Next j
Next i
End Sub

 

[Carim]

Hello Jean,

If I may add a warning, Greg's solution is spot on and absolutely
perfect ...

I just want to stress the two assumptions Greg has made :

1. No header row

2. The last row exists , is empty, ready for the totals to appear

HTH
Cheers
Carim

 

[Greg Maxey]

To save you from possibly having to ask:
Sub Scratchmacro()
Dim oTbl As Word.Table
Dim i As Long
Dim j As Long
Dim pCount As Long
Set oTbl = Selection.Tables(1) 'Or ActiveDocument.Tables(?)"
'If no last row exists for the totals then enable the next line *
'oTbl.Rows.Add '*
For i = 1 To oTbl.Columns.Count
pCount = 0
For j = 1 To oTbl.Rows.Count
'For j = 2 To oTbl.Rows.Count 'Use this if you have a header row
If j = oTbl.Rows.Count Then oTbl.Cell(j, i).Range.Text = pCount
If Len(oTbl.Cell(j, i).Range.Text) > 2 Then
pCount = pCount + 1
End If
Next j
Next i
End Sub

 

[Jean Laflèche]

Dear Mr. Maxey,

Almost perfect for somebody who said He didn't understand my example!

After the merging itself, there's no blank last row (I forgot to say).

The way You've constructed the macro, it totally erases the last row of the
existing Table and replace it content by the result of the calculation done
by the macro, less one. For it works perfectly, I had effectively to add,
manually, a new row after the last one.

Can adding automatically that new needed row, be easily done by adding a few
lines in the above mentioned macro? I won't be alone to work with those
mergings, I would appreciate it could be easy for collegues that are less
"friendly" with Word and the world of macros.

If not, I'll still be very Thankfull for the great job You've already done.

 

[Greg Maxey]

Jean,

No reason to be so formal. You can call me Greg or even Yo Pilgrim will do
;-)

Did my second post not provide your solution?

Try:
Sub Scratchmacro()
Dim oTbl As Word.Table
Dim i As Long
Dim j As Long
Dim pCount As Long
Set oTbl = Selection.Tables(1) 'Or ActiveDocument.Tables(?)"
oTbl.Rows.Add
For i = 1 To oTbl.Columns.Count
pCount = 0
For j = 2 To oTbl.Rows.Count 'Use "For j = 1" if you don't have a header
row
If j = oTbl.Rows.Count Then oTbl.Cell(j, i).Range.Text = pCount
If Len(oTbl.Cell(j, i).Range.Text) > 2 Then
pCount = pCount + 1
End If
Next j
Next i
End Sub

 

[Jean Laflèche]

Greg,

Yes, I didn't noticed it before I wrote You.

Thank's a lot again for your great job, it works quite well.