P
PeteCresswell
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
---------------------------------------------------------
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
---------------------------------------------------------