Determining if text in a table wraps

[Robin Hammond]

This is driving me nuts and there must be a better solution..

I have a routine hitting a database, creating a table or tables based on
extracted data. The objective is to have all these tables have uniform left
column width containing the row title, and a single uniform width for all
the other columns so that they format nicely within the overall document. We
also need to make sure that all the tables show the same column widths so
that things look consistent. The data in each cell of a table can vary in
length quite considerably depending on units etc, ranging from billions down
to percentages.

I can optimise the column widths for the number of characters ok, but need
to adjust the font size so that there is no text wrapping. To do this we
need to work out if there are any wrapped cells in each table. The following
function works but it is horribly slow, and some of my reports could contain
hundreds of tables. Checking each and every cell using the selection clause
below is an ugly solution.

So here's the question: Can anyone provide a better function that identifies
if any single cell in a table wraps.

Thanks in advance.

Robin Hammond
www.enhanceddatasystems.com

Public Function CheckNoWrapping(tblOutput As Table) As Boolean
Dim nRowCounter As Integer
Dim nColCounter As Integer
Dim rngCell As Range
'NOTE: preassumes that at least one row does not wrap

With tblOutput
For nColCounter = 1 To .Columns.Count
For nRowCounter = 1 To .Rows.Count
With .Cell(nRowCounter, nColCounter)
If .Range.Characters.Count = 1 Then GoTo SkipBlank
Set rngCell = .Range
rngCell.MoveEnd wdCharacter, -1
rngCell.Select
Selection.Collapse wdCollapseStart
Selection.EndKey wdLine
Selection.MoveRight wdCharacter, 1
Selection.MoveLeft wdCharacter, 1
If Selection.InRange(rngCell) = True Then
CheckNoWrapping = False
Exit Function
End If
End With
SkipBlank:
Next nRowCounter
Next nColCounter
End With
CheckNoWrapping = True
End Function