This is a spinoff from the "'ColumnOverflow'" Function?" thread
because it seems like a sufficiently-different question to warrent
it's own subject line....


I've got a little routine that boogies through rows/columns, looking
for cells rendered as "#" and expands columns to get rid of the "#".
This applies to date and numeric cells.

But now I would like to do the same thing with text cells.

I've got it working - sort of... - for monospaced fonts, but I would
like to make it handle variable-spaced fonts.

There are a lot of Google hits around this, but none of them really
cut to the chase for my situation.

Can anybody point me to something?

Here's my current code:
---------------------------------------------------------
Sub ExpandColumns()
Dim curCell As Range

Dim lastRow As Long
Dim lastCol As Long
Dim lastCell As Long

Dim i As Long
Dim R As Long
Dim C As Long

Dim curWid As Double

Const incWid As Double = 0.1
Const maxWid As Long = 50

Application.ScreenUpdating = False

If WorksheetFunction.CountA(Cells) 0 Then
lastCol = Cells.Find(What:="*", After:=[A1],
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row

For R = 1 To lastRow
For C = 1 To lastCol
curWid = Columns(C).Width
Set curCell = Cells(R, C)

If Left(curCell.Text, 1) = "#" Then
Do Until Left(curCell.Text, 1) < "#"
curWid = curWid + incWid
Columns(C).ColumnWidth = curWid / 10
Loop
End If
Next C
Next R

Application.ScreenUpdating = True
Set curCell = Nothing
End If
End Sub
---------------------------------------------------------

Code Correction.

I pasted the wrong version of code into the sample.

Here is the latest-and-greatest:
--------------------------------------------------------
Sub ExpandCols()
Dim curCell As Range

Dim lastRow As Long
Dim lastCol As Long
Dim lastCell As Long

Dim R As Long
Dim C As Long

Dim curWid As Double

Const incWid As Double = 1
Const maxWid As Long = 50
Const slopFactor As Long = 2

Application.ScreenUpdating = False

If WorksheetFunction.CountA(Cells) 0 Then
' ---------------------------------------------
' Determine last column/row

lastCol = Cells.Find(What:="*", After:=[A1],
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row

' ---------------------------------------------
' Make each column big enough to render largest text plus a slop
factor

For R = 1 To lastRow
For C = 1 To lastCol
curWid = Columns(C).ColumnWidth
Set curCell = Cells(R, C)

If Left(curCell.Text, 1) = "#" Then
Do Until Left(curCell.Text, 1) < "#"
curWid = curWid + incWid
Columns(C).ColumnWidth = curWid
Loop
Columns(C).ColumnWidth = Columns(C).ColumnWidth + 2
End If
Next C

Next R

Application.ScreenUpdating = True

' ---------------------------------------------
' - Make header row alignments same as detail row alignments
' except for dates where we force alignment to center

For C = 1 To lastCol
If IsDate(Cells(2, C)) Then
Columns(C).HorizontalAlignment = xlCenter
Else
Cells(1, C).HorizontalAlignment = Cells(2,
C).HorizontalAlignment
End If

Cells(1, C).Interior.ColorIndex = 15
Next C

Set curCell = Nothing
End If
End Sub
--------------------------------------------------------

If you're getting #######'s to appear for text cells, then widening the column
is not the solution.

You can change the format to General (or anything but Text).

Excel has a display problem with strings between 256 and 1024 characters long in
cells formatted as text.

PeteCresswell wrote:

This is a spinoff from the "'ColumnOverflow'" Function?" thread
because it seems like a sufficiently-different question to warrent
it's own subject line....

I've got a little routine that boogies through rows/columns, looking
for cells rendered as "#" and expands columns to get rid of the "#".
This applies to date and numeric cells.

But now I would like to do the same thing with text cells.

I've got it working - sort of... - for monospaced fonts, but I would
like to make it handle variable-spaced fonts.

There are a lot of Google hits around this, but none of them really
cut to the chase for my situation.

Can anybody point me to something?

Here's my current code:
---------------------------------------------------------
Sub ExpandColumns()
Dim curCell As Range

Dim lastRow As Long
Dim lastCol As Long
Dim lastCell As Long

Dim i As Long
Dim R As Long
Dim C As Long

Dim curWid As Double

Const incWid As Double = 0.1
Const maxWid As Long = 50

Application.ScreenUpdating = False

If WorksheetFunction.CountA(Cells) 0 Then
lastCol = Cells.Find(What:="*", After:=[A1],
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) .Row

For R = 1 To lastRow
For C = 1 To lastCol
curWid = Columns(C).Width
Set curCell = Cells(R, C)

If Left(curCell.Text, 1) = "#" Then
Do Until Left(curCell.Text, 1) < "#"
curWid = curWid + incWid
Columns(C).ColumnWidth = curWid / 10
Loop
End If
Next C
Next R

Application.ScreenUpdating = True
Set curCell = Nothing
End If
End Sub
---------------------------------------------------------

--

Dave Peterson

On Oct 26, 10:41*am, Dave Peterson wrote:
If you're getting #######'s to appear for text cells, then widening the column
is not the solution.

Agreed.

My approach for text cells will differ.

Instead of looking for "#", I think I should be determining the length
of the text as it will be rendered using the
Cell.Font.Name, .Size, .Bold... and whatever else... and then
comparing that length to Column.ColumnWidth and adjusting the column's
width accordingly.

Problem is I don't have a clue as to how to determine with width of a
text string given a specified font + the font's characteristics (like
size, bold, italic and so-forth).

On Oct 26, 12:01*pm, PeteCresswell wrote:

Problem is I don't have a clue as to how to determine with width of a
text string given a specified font + the font's characteristics (like
size, bold, italic and so-forth).

If push came to shove, I suppose I *could* paste the string in
question into an invisible cell somewhere - with autofit or whatever
turned on, set the cell's .Font props, and then retrieve .ColumnWidth.

But I suspect that would kick the brains out of response time.

Problem is I don't have a clue as to how to determine with
width of a text string given a specified font + the font's
characteristics (like size, bold, italic and so-forth).

If push came to shove, I suppose I *could* paste the string
in question into an invisible cell somewhere - with autofit or
whatever turned on, set the cell's .Font props, and then
retrieve .ColumnWidth.

But I suspect that would kick the brains out of response time.

Response time? No, not really...

Dim Source As Range, InvisibleCell As Range
Set Source = Range("C6")
Set InvisibleCell = Range("C6").Offset(26, 3)
Source.Copy InvisibleCell
InvisibleCell.Columns.AutoFit
If InvisibleCell.ColumnWidth Source.ColumnWidth Then
MsgBox "The text is too long!"
Else
MsgBox "The text fits!!!"
End If

Note that the column for the "invisible cell" cannot be the same column as
for the "source cell". In the above code, just set the Source and
InvisibleCell values as needed or desired. I will point out, though, that
this (or probably the API equivalents) will seem to return "text is too
long" messages for text that **looks** like it fits... the reason is because
there is an invisible box around each character with a blank area (in a
"normal" looking font) all around the character (for spacing purposes when
butted up against an adjacent character) which, if any part of it breaches
the cell's edge (even if what we see as the character appears wholly inside
the cell), will report the text as being wider than the cell.

--
Rick (MVP - Excel)

On Oct 26, 12:29*pm, "Rick Rothstein"
wrote:
I will point out, though, that
this (or probably the API equivalents) will seem to return "text is too
long" messages for text that **looks** like it fits... the reason is because
there is an invisible box around each character with a blank area (in a
"normal" looking font) all around the character (for spacing purposes when
butted up against an adjacent character) which, if any part of it breaches
the cell's edge (even if what we see as the character appears wholly inside
the cell), will report the text as being wider than the cell.

For my application that's a "plus", since I am already adding a "slop
factor" to my sizes so the data does not look to scrunched up within
the cell.

I'll give this a shot later today.

Thanks!