find, format tabs and replace in table cells

[ckxplus]

I've got tables with counts and percentages in many of the table cells
in the form "35.3% (47/133)". I want the percentages to align so I
wrote a macro to define right-aligning tab positions at 40% and 100%
of the cells usable width and then insert a tab character between the
percentage sign and the opening parenthesis. It works but it's a very
brute force method because it defines tabs in each cell of all tables
in a document. What I'd like to be able to do is to search for a cell
with percentages and counts and only then to define the tab positions.
Could someone help me out in this?

Here's my macro in its present state. It takes about 25 seconds on a
19 page document.

Public Sub TabsForPctAndCount()
Dim aRange As Word.Range
Dim oTable As Word.Table
Dim oCell As Cell
Dim UseableWidth As Single

Set aRange = ActiveDocument.Range(0, 0)
System.Cursor = wdCursorWait ' Displays the hourglass
StatusBar = "Defining tab positions in tables ..."

'Insert right aligning tab positions at 40% and 100% of each cell
For Each oTable In ActiveDocument.Tables
For Each oCell In oTable.Range.Cells
UseableWidth = oCell.Width - oCell.LeftPadding -
oCell.RightPadding
oCell.Range.ParagraphFormat.TabStops.ClearAll
oCell.Range.ParagraphFormat.TabStops.add
Position:=UseableWidth * 0.4, Alignment:=wdAlignTabRight
oCell.Range.ParagraphFormat.TabStops.add
Position:=UseableWidth, Alignment:=wdAlignTabRight
Next oCell
Next oTable

StatusBar = "Inserting tabs between percentages and counts ..."
'Replace a "XX.X% (" by "\tXX.X%\t("
With aRange.find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([0-9.]@%)[ ]@\("
.Replacement.Text = "^t\1^t("
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute replace:=wdReplaceAll
End With

System.Cursor = wdCursorNormal ' Normal cursor
StatusBar = "Macro TabsForPctAndCount completed."
End Sub

Thanks for any help,
John Hendrickx

 

[Bear]

I know this is "Discussions in Word PROGRAMMING" and all, but I think you're
on the wrong track here.

The tabs you're talking about are a property of the paragraph style, not the
cell. You should be defining a style for the "35.3% (47/133)" data and
using your macro to apply that style, plus any tab characters you might like,
to cells that contain data in that format.

You're already identifying text in that format in the search operation
that's inserting your tabs. So all you really need to do is add the new style
to the replace arguments.

Bear

 

[Helmut Weber]

Hi John,

What I'd like to be able to do is to search for a cell
with percentages and counts and only then to define the tab positions.
Could someone help me out in this?

As you search in the first part of your code
only tables anyway and access one cell after each other,
you could as well search the actual cell's range for

..Text = "([0-9.]@%)[ ]@\("

which is not bullet proof, by the way.
Try [0-9]{1,2}.[0-9]{1,2}% ....

Unless you got values like 560.5678 percent.

Here's my macro in its present state. It takes about 25 seconds on a
19 page document.

You could use
With ocll.range.find
....

Hmm, but I wonder whether this will be remarkably faster.
It depends on how often the searched for expression
would be found outside of tables.

In no such expression is outside of a table,
then restricting the search to tables will hardly pay off
for only 19 pages, IMHO.

I'd suggest to select the tables,
search the tables only for your expression,
then do the replacement and the formatting.

In this case I recommend selection,
as it is often faster in tables than range.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[ckxplus]

Bear's suggestion to define a style with tab positions defined there
was a good one, provide the tab positions would be the same for all
cells containing counts and percentages. I can't always know if that
will be the case, that's why I want to define the first tab position
at 40% of the cell's usable width.

Helmut, your warning about the wildcard search not being bullet proof
was spot on. For some reason, it "found" text in the tables of
contents although there were no percentage signs there. Replace did
nothing so it looks like this is a bug (I'm using Word 2000).

I can't do the wildcard search right though because the percentages
can contain "100%". It *should* be possible to cover all options with
"([0-9]{1,3}[.]{0,1}[0-9]{0-3}%)[ ]@\(". Unfortunately, Word wildcards
don't support zero or more matches (http://word.mvps.org/FAQs/General/
UsingWildcards.htm). I changed the search string to "([0-9.]{1,8}%)[ ]
{1,5}\(".

Here's the modified version, it runs in slightly over a second, fast
enough in any case. That is, after I specified "wrap=wdFindStop".
Using wdFindContinue, you end up in an infinite loop. I don't
understand that, all occurrences of the find text had been found and
replaced, a manual find found no more occurences. Any explanations?

Public Sub TabsForPctAndCount2()
Dim aRange As Range
Dim oCell As Cell
Dim UseableWidth As Single

Set aRange = ActiveDocument.Range
System.Cursor = wdCursorWait ' Displays the hourglass

'Replace a "XX.X% (" by "\tXX.X%\t("
With aRange.find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([0-9.]{1,8}%)[ ]{1,5}\("
.Replacement.Text = "^t\1^t("
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute
If aRange.Information(wdWithInTable) Then
aRange.Select
Set oCell = Selection.Cells(1)
UseableWidth = oCell.Width - oCell.LeftPadding -
oCell.RightPadding
oCell.Range.ParagraphFormat.TabStops.ClearAll
oCell.Range.ParagraphFormat.TabStops.add
Position:=UseableWidth * 0.4, Alignment:=wdAlignTabRight
oCell.Range.ParagraphFormat.TabStops.add
Position:=UseableWidth, Alignment:=wdAlignTabRight
End If
Loop
End With

System.Cursor = wdCursorNormal ' Normal cursor
StatusBar = "Macro TabsForPctAndCount completed."
End Sub


Thanks for your suggestions,
John Hendrickx

Hi John,

What I'd like to be able to do is to search for a cell
with percentages and counts and only then to define the tab positions.
Could someone help me out in this?

As you search in the first part of your code
only tables anyway and access one cell after each other,
you could as well search the actual cell's range for

.Text = "([0-9.]@%)[ ]@\("

which is not bullet proof, by the way.
Try [0-9]{1,2}.[0-9]{1,2}% ....

Unless you got values like 560.5678 percent.

Here's my macro in its present state. It takes about 25 seconds on a
19 page document.

You could use
With ocll.range.find
...

Hmm, but I wonder whether this will be remarkably faster.
It depends on how often the searched for expression
would be found outside of tables.

In no such expression is outside of a table,
then restricting the search to tables will hardly pay off
for only 19 pages, IMHO.

I'd suggest to select the tables,
search the tables only for your expression,
then do the replacement and the formatting.

In this case I recommend selection,
as it is often faster in tables than range.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[Helmut Weber]

Hi John,

whatever I do, it is pretty slow,
if one wants to be on the safe side
and not replace anything outside of tables.

OK, 30 + seconds is pretty slow.
On the other hand, I have sometimes to provide
statistics on files on a company server,
which takes hours and hours.

Public Sub TabsForPctAndCount2x()

Dim t As Single
t = Timer
Dim aRange As Range
Dim oCell As Cell
Dim UseableWidth As Single

Set aRange = ActiveDocument.Range
System.Cursor = wdCursorWait ' Displays the hourglass
Application.ScreenUpdating = False

With aRange.Find
.Text = "([0-9.]{1,8}%)[ ]{1,5}\("
.Replacement.Text = "^t\1^t("
.MatchWildcards = True
While .Execute
If aRange.Information(wdWithInTable) Then
.Execute Replace:=wdReplaceOne
Set oCell = aRange.Cells(1)
UseableWidth = _
oCell.Width - oCell.LeftPadding - oCell.RightPadding
oCell.Range.ParagraphFormat.TabStops.ClearAll
oCell.Range.ParagraphFormat.TabStops.Add _
Position:=UseableWidth * 0.4, _
Alignment:=wdAlignTabRight
oCell.Range.ParagraphFormat.TabStops.Add _
Position:=UseableWidth, _
Alignment:=wdAlignTabRight
aRange.Start = oCell.Range.End + 1
aRange.End = ActiveDocument.Range.End
End If
Wend
End With

System.Cursor = wdCursorNormal ' Normal cursor
StatusBar = "Macro TabsForPctAndCount completed."
MsgBox Timer - t
End Sub

Working with ranges in tables is a special challenge,
as the end-of-doc mark is sometimes 1 character long
and sometimes 2 characters long.

When working with replace in ranges,
you have sometimes to take care about redefining the
range from the found spot to the end of document.

Its endless.

These are the lines which prevent an endless loop.

aRange.Start = oCell.Range.End + 1 ' note +1
aRange.End = ActiveDocument.Range.End

HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

 

[ckxplus]

Thanks Helmut, this works fine. It's very zippy on my machine, it
took .375 seconds (dual core athlon 3800+ with 1G RAM running
Win2000). The timer trick is good to know and I think I understand now
how to do search/replace with ranges.

Thanks again,
John Hendrickx

 

[Helmut Weber]

errata:

the end-of-doc mark is sometimes 1 character long
and sometimes 2 should be

the end-of-cell (!) mark is sometimes 1 character long
and sometimes 2

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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