Word2000

Here is a puzzle:

I write the same type of document repeatedly. I paste dozens and dozens of
tables into the document from Access. I don't need to modify the
tables--they are fine. Each table is basically the same--two columns of
addresses side by side. One list is always longer than the other (i.e.,
blank cells at the bottom of the short list). I need to compare the two
columns by counting addresses and calculating the percentage of the short
one to the long one.

I realize how to manually do this with stated cell ranges--or even a
spreadsheet inserted, but I have hundreds to do and I need an automated way
of doing this.

Presently, I accomplish this by putting my cursor at the bottom of the list
and running a macro that enters {=Count(Above)-1}. The 'minus one' subtracts
the column header from the count. This is fine, except for longer lists
where I want the total count to appear at the top of the table, rather than
at the bottom--on the next page. Then I type the counts and percentage in a
text line above the table (using a calculator to figure the ratio!).

The ultimate in speed and ease would be: 1) paste the table, 2) run a macro
that enters a formula field in each column header and enters another field
to calculate the percentage--oh, and it would not count the blank cells at
the bottom of the short list!

That last part is the kicker since Count(below) will not ignore the blank
cells. Is there something I can put in the first blank cell below the last
entry in the short list that will 'stop' the count formula? Or can I put the
Count(above)-1 field in that first blank row and have a field in the column
header restate the count found in that cell? (without manually referring to
it, like a25)?

I need something cleaver, I believe. Any other ideas?

Brad H.

Brad,

This might get you part way there. Paste your table, put the cursor in
the heading cell of the short column and run the following macro:

Sub ScratchMacro()
Dim iCount As Long
Dim oCell As Cell
Dim oCol As Column
Dim oTable As Table
Dim X As Long

If Selection.Information(wdWithInTable) = True Then
Set oTable = Selection.Tables(1)
Set oCol = Selection.Columns(1)
Else
MsgBox "Selection is not in a table"
Exit Sub
End If
iCount = -1
X = oTable.Rows.Count - 1
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCount = iCount + 1
End If
Next
Selection.InsertBefore "" & (iCount / X) * 100 & " %"
End Sub

If your short column is always column 1 or column 2 then I suppose that
you could refine this macor to perform the same rountine for each table
in activedocument.tables. I haven't figured that out though.

Brad,

OK. If the short column is always column 1, then you could use this to
calculate all tables:

Sub ScratchMacro1()
Dim iCount As Long
Dim oCell As Cell
Dim oCol As Column
Dim oTable As Table
Dim X As Long
Dim i As Long
For i = 1 To ActiveDocument.Tables.Count
Set oTable = ActiveDocument.Tables(i)
Set oCol = oTable.Columns(1)
iCount = -1
X = oTable.Rows.Count - 1
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCount = iCount + 1
End If
Next
oTable.Cell(1, 1).Range.Select
Selection.InsertAfter " " & Round((iCount / X) * 100, 2) & " %"
Next
End Sub

If the short column could be column 1 or 2 then I am currently stumped.
I'll keep charging and see if I can come up with a solution.

Brad,

OK this looks gnarly but seems to work. I inserted a half a dozen two
colunm tables. I headed three of the tables Short List and Long List.
I headed the other three Long List and Short List. I then filled all
of the long lists and "shorted" the short list. I then ran the
following macro which appears to put the percentage in the correct
column. As an added advantage, it doesn't matter if the long list is
full and it doesn't matter if the short list has empty cells between
addresses :-)

Sub ScratchMacro2()
Dim iCol1Count As Long
Dim iCol2Count As Long
Dim oCell As Cell
Dim oCol As Column
Dim oTable As Table
Dim i As Long
For i = 1 To ActiveDocument.Tables.Count
Set oTable = ActiveDocument.Tables(i)
Set oCol = oTable.Columns(1)
iCol1Count = -1
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol1Count = iCol1Count + 1
End If
Next
Set oCol = Nothing
Set oCol = oTable.Columns(2)
iCol2Count = -1
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol2Count = iCol2Count + 1
End If
Next
If iCol1Count iCol2Count Then
oTable.Cell(1, 1).Range.Select
Selection.InsertAfter " " & Round((iCol1Count / _
iCol2Count) * 100, 2) & " %"
Else
oTable.Cell(1, 2).Range.Select
Selection.InsertAfter " " & Round((iCol2Count / _
iCol1Count) * 100, 2) & " %"
End If
Next
End Sub

Hey, Greg.
Sorry it's been awhile. I did get the cleaner version of your macro via
email. It's great. A couple of things I wasn't clear on, though.

Rather than inserting text for column counts and the percentage, these need
to be a field codes. (Subsequent adding or deleting to the list is why. Then
use Ctrl+F9 to update the fields).

Second, rather than the macro running on all the tables in the document, I
want it to run on the one my cursor is in. The scenario is that I paste a
2-column table, then put the cursor at the top of the first column and run
the macro. For example, here's a simple freshly pasted table (the table has
2 columns and 3 rows):

Unit1 Unit1
Unit3 Unit2
Unit3

So then I put my cursor in the upper left cell and run the macro which:
1. Adds a row above
2. Inserts a field code in each column header that counts the Units below.
3. Adds another row above.
4. Inserts a field code that calculates the percentage of column A to column
B.
The result is this (the table has 2 columns and 5 rows):

67%
2 3
Unit1 Unit1
Unit3 Unit2
Unit3

What I'm after may not be possible with field codes in all three spots--cell
A2 in particular, because there is a blank cell in the column, so I may have
to live with text inserted instead of a field code for that one. The rest is
doable, right?

Brad H.

Brad,

I don't think (or don't have time to figure out) how to go about the field
route. It seems difficult since we couldn't figure out how to get a field
to do the initial calculation. Here is an option that might work. There
are two macros. One takes your raw table adds the two rows, performs and
displays the count and calculation. You must have the cursor at the start
of Cell 1, 1 to initiate.

The second macro will recalculate if you add or delete entries. What do you
think?

Sub SetupTable()
Dim iCol1Count As Long
Dim iCol2Count As Long
Dim oCell As Cell
Dim oCol As Column
Dim oTable As Table
Dim rChk

Set oTable = Selection.Tables(1)
If Selection.Start = oTable.Cell(1, 1).Range.Start Then
Selection.InsertRowsAbove 2
Else: MsgBox "Put the cursor at the start of the first cell"
Exit Sub

End If
Set oCol = oTable.Columns(1)
iCol1Count = 0
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then

iCol1Count = iCol1Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 1).Range.Text = iCol1Count
Set oCol = oTable.Columns(2)
iCol2Count = 0
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol2Count = iCol2Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 2).Range.Text = iCol2Count
oTable.Cell(1, 1).Range.Text = "" & Round((iCol1Count / _
iCol2Count) * 100, 2) & " %"

End Sub
Sub RefreshTable()
Dim iCol1Count As Long
Dim iCol2Count As Long
Dim oCell As Cell
Dim oCol As Column
Dim oTable As Table

Set oTable = Selection.Tables(1)
Set oCol = oTable.Columns(1)
iCol1Count = -2
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then

iCol1Count = iCol1Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 1).Range.Text = iCol1Count
Set oCol = oTable.Columns(2)
iCol2Count = -1
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol2Count = iCol2Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 2).Range.Text = iCol2Count
oTable.Cell(1, 1).Range.Text = "" & Round((iCol1Count / _
iCol2Count) * 100, 2) & " %"

End Sub


--
Greg Maxey/Word MVP
A Peer in Peer to Peer Support

Brad H. wrote:
Hey, Greg.
Sorry it's been awhile. I did get the cleaner version of your macro
via email. It's great. A couple of things I wasn't clear on, though.

Rather than inserting text for column counts and the percentage,
these need to be a field codes. (Subsequent adding or deleting to the
list is why. Then use Ctrl+F9 to update the fields).

Second, rather than the macro running on all the tables in the
document, I want it to run on the one my cursor is in. The scenario
is that I paste a 2-column table, then put the cursor at the top of
the first column and run the macro. For example, here's a simple
freshly pasted table (the table has 2 columns and 3 rows):

Unit1 Unit1
Unit3 Unit2
Unit3

So then I put my cursor in the upper left cell and run the macro
which:
1. Adds a row above
2. Inserts a field code in each column header that counts the Units
below.
3. Adds another row above.
4. Inserts a field code that calculates the percentage of column A to
column B.
The result is this (the table has 2 columns and 5 rows):

67%
2 3
Unit1 Unit1
Unit3 Unit2
Unit3

What I'm after may not be possible with field codes in all three
spots--cell A2 in particular, because there is a blank cell in the
column, so I may have to live with text inserted instead of a field
code for that one. The rest is doable, right?

Brad H.

Brad,

Refined a little and undoubtably still rough. Still this version may make
it a little easier and avoid some errors. Basically I added a string check
so if you run the setup macro on a table already calculated it will find the
% in the first cell string and jump to the Refresh macro. This will prevent
you adding two more rows by accident. I am sure this could be abbreviated
and refined some more, but if you are only operting on single tables it may
do. Let me know.

Sub SetupTable()
Dim iCol1Count As Long
Dim iCol2Count As Long
Dim oCell As Cell
Dim oCol As Column
Dim oTable As Table
Dim rChk As Range

If Selection.Information(wdWithInTable) Then
Set oTable = Selection.Tables(1)
Set rChk = oTable.Cell(1, 1).Range
If InStr(rChk, "%") Then
RefreshTable
Exit Sub
End If
oTable.Rows(1).Select
Selection.InsertRowsAbove 2
Selection.Collapse
Set oCol = oTable.Columns(1)
iCol1Count = 0
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol1Count = iCol1Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 1).Range.Text = iCol1Count
Set oCol = oTable.Columns(2)
iCol2Count = 0
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol2Count = iCol2Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 2).Range.Text = iCol2Count
oTable.Cell(1, 1).Range.Text = "" & Round((iCol1Count / _
iCol2Count) * 100, 2) & " %"
Else: MsgBox "Put the cursor in a table to calculate"
End If
End Sub
Sub RefreshTable()
Dim iCol1Count As Long
Dim iCol2Count As Long
Dim oCell As Cell
Dim oCol As Column
Dim oTable As Table

If Selection.Information(wdWithInTable) Then
Set oTable = Selection.Tables(1)
Set oCol = oTable.Columns(1)
iCol1Count = -2
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol1Count = iCol1Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 1).Range.Text = iCol1Count
Set oCol = oTable.Columns(2)
iCol2Count = -1
For Each oCell In oCol.Cells
If oCell.Range.Characters.Count 1 Then
iCol2Count = iCol2Count + 1
End If
Next
Set oCol = Nothing
oTable.Cell(2, 2).Range.Text = iCol2Count
oTable.Cell(1, 1).Range.Text = "" & Round((iCol1Count / _
iCol2Count) * 100, 2) & " %"
Else: MsgBox "Put the cursor in a the table to refresh"
End If
End Sub

--
Greg Maxey/Word MVP
A Peer in Peer to Peer Support

Brad H. wrote:
Hey, Greg.
Sorry it's been awhile. I did get the cleaner version of your macro
via email. It's great. A couple of things I wasn't clear on, though.

Rather than inserting text for column counts and the percentage,
these need to be a field codes. (Subsequent adding or deleting to the
list is why. Then use Ctrl+F9 to update the fields).

Second, rather than the macro running on all the tables in the
document, I want it to run on the one my cursor is in. The scenario
is that I paste a 2-column table, then put the cursor at the top of
the first column and run the macro. For example, here's a simple
freshly pasted table (the table has 2 columns and 3 rows):

Unit1 Unit1
Unit3 Unit2
Unit3

So then I put my cursor in the upper left cell and run the macro
which:
1. Adds a row above
2. Inserts a field code in each column header that counts the Units
below.
3. Adds another row above.
4. Inserts a field code that calculates the percentage of column A to
column B.
The result is this (the table has 2 columns and 5 rows):

67%
2 3
Unit1 Unit1
Unit3 Unit2
Unit3

What I'm after may not be possible with field codes in all three
spots--cell A2 in particular, because there is a blank cell in the
column, so I may have to live with text inserted instead of a field
code for that one. The rest is doable, right?

Brad H.

Greg,

I LIKE it!

I'm OK with not using fields since the TableRefresh procedure effectively
does the same thing as F9. And, yes, only one table at a time will be worked
on.

I learned VBA in MS Access; MS Word has some new lingo, apparantly. Can you
post a good learning resource?

So far it seems great! I can add formatting and such to the macro. (I like
the MsgBox, by the way.)

Brad H.

Brad,

Glad it works for you. As for learning resource..., questions like your are
the best I know. I have not read any VBA books to offer a suggestion.
There is the WordMVP FAQ site that offers many tips:
http://word.mvps.org/FAQs/index.htm

--
Greg Maxey/Word MVP
A Peer in Peer to Peer Support

Brad H. wrote:
Greg,

I LIKE it!

I'm OK with not using fields since the TableRefresh procedure
effectively does the same thing as F9. And, yes, only one table at a
time will be worked on.

I learned VBA in MS Access; MS Word has some new lingo, apparantly.
Can you post a good learning resource?

So far it seems great! I can add formatting and such to the macro. (I
like the MsgBox, by the way.)

Brad H.