Autofit single cell text

I am trying to autofit rows, all of which one column has cells that contain
anywhere from 0 - 1500 characters. No cells are merged on the worksheet. Each
of these cells with content have manual linebreaks in them to designate
seperate entries (each line contains an action completed on a certain date).
These lines within a cell may contain 10 characters or 100. Autofitting works
about 75% of the time, while the other 25% of the time it will cut off
several lines at the bottom (without maxing out at a row height of 409).

I have created a (admittedly crude) macro to calculate rowheight based on
static font size (in this case) and an assumption that each line takes up
~75% of the column.
Rowheight = (Amount of chars * determined character height ) / chars per
column

The problem with this is there is usually a fair bit of white space at the
bottom of the cells (wasting paper), and in specialy circumstances could
still cut of cells if many entries are short (ie take up less column space).

Is there anyway to get autofit to work 100% of the time and not cut of rows
(preferable) or a better method of "manually autofitting".


Here is a snippet from the code where the "autofitting" is done:

Do
'Determines if this row has information
emptyRow = IsEmpty(Range("A" & rowNum).Value)

'If this row contains information
If emptyRow = False Then
Rows(rowNum & ":" & rowNum).EntireRow.AutoFit

'Calculate amount of characters in cell
Range("M" & rowNum).FormulaR1C1 = "=LEN(RC[-1])"

'Theoretical row height with ~75% of column used up (55 units)
and line height of 14 chars
rowHeightTest = (Range("M" & rowNum).Value * 14) / 40

'If theoretical number is greater than autofit number
If rowHeightTest Rows(rowNum & ":" & rowNum).RowHeight Then

'Failsafe if theoretical number is greater than max.
If rowHeightTest 409 Then rowHeightTest = 409
Rows(rowNum & ":" & rowNum).RowHeight = rowHeightTest
End If

'Clean up temp. cells and cycle to next cell
Range("M" & rowNum).ClearContents
rowNum = rowNum + 1
End If

Loop Until emptyRow = True

Try changing the vertical allignment to TOP.

Format - Cells - Allignment - Verticle - Top

"Jay" wrote:

I am trying to autofit rows, all of which one column has cells that contain
anywhere from 0 - 1500 characters. No cells are merged on the worksheet. Each
of these cells with content have manual linebreaks in them to designate
seperate entries (each line contains an action completed on a certain date).
These lines within a cell may contain 10 characters or 100. Autofitting works
about 75% of the time, while the other 25% of the time it will cut off
several lines at the bottom (without maxing out at a row height of 409).

I have created a (admittedly crude) macro to calculate rowheight based on
static font size (in this case) and an assumption that each line takes up
~75% of the column.
Rowheight = (Amount of chars * determined character height ) / chars per
column

The problem with this is there is usually a fair bit of white space at the
bottom of the cells (wasting paper), and in specialy circumstances could
still cut of cells if many entries are short (ie take up less column space).

Is there anyway to get autofit to work 100% of the time and not cut of rows
(preferable) or a better method of "manually autofitting".


Here is a snippet from the code where the "autofitting" is done:

Do
'Determines if this row has information
emptyRow = IsEmpty(Range("A" & rowNum).Value)

'If this row contains information
If emptyRow = False Then
Rows(rowNum & ":" & rowNum).EntireRow.AutoFit

'Calculate amount of characters in cell
Range("M" & rowNum).FormulaR1C1 = "=LEN(RC[-1])"

'Theoretical row height with ~75% of column used up (55 units)
and line height of 14 chars
rowHeightTest = (Range("M" & rowNum).Value * 14) / 40

'If theoretical number is greater than autofit number
If rowHeightTest Rows(rowNum & ":" & rowNum).RowHeight Then

'Failsafe if theoretical number is greater than max.
If rowHeightTest 409 Then rowHeightTest = 409
Rows(rowNum & ":" & rowNum).RowHeight = rowHeightTest
End If

'Clean up temp. cells and cycle to next cell
Range("M" & rowNum).ClearContents
rowNum = rowNum + 1
End If

Loop Until emptyRow = True

Joel,

Thanks for the reply. I have tried several vertical alignment options (top,
bottom & distributed) and it doesn't fix the problem.

"Joel" wrote:

Try changing the vertical allignment to TOP.

Format - Cells - Allignment - Verticle - Top

I know that this post is a year old today but I must find a solution for this issue. Did you ever find a fix for this? It is driving me crazy!



Ja wrote:

Autofit single cell text
07-Oct-08

I am trying to autofit rows, all of which one column has cells that contain
anywhere from 0 - 1500 characters. No cells are merged on the worksheet. Each
of these cells with content have manual linebreaks in them to designate
seperate entries (each line contains an action completed on a certain date).
These lines within a cell may contain 10 characters or 100. Autofitting works
about 75% of the time, while the other 25% of the time it will cut off
several lines at the bottom (without maxing out at a row height of 409).

I have created a (admittedly crude) macro to calculate rowheight based on
static font size (in this case) and an assumption that each line takes up
~75% of the column.
Rowheight = (Amount of chars * determined character height ) / chars per
column

The problem with this is there is usually a fair bit of white space at the
bottom of the cells (wasting paper), and in specialy circumstances could
still cut of cells if many entries are short (ie take up less column space).

Is there anyway to get autofit to work 100% of the time and not cut of rows
(preferable) or a better method of "manually autofitting".


Here is a snippet from the code where the "autofitting" is done:

Do
'Determines if this row has information
emptyRow = IsEmpty(Range("A" & rowNum).Value)

'If this row contains information
If emptyRow = False Then
Rows(rowNum & ":" & rowNum).EntireRow.AutoFit

'Calculate amount of characters in cell
Range("M" & rowNum).FormulaR1C1 = "=LEN(RC[-1])"

'Theoretical row height with ~75% of column used up (55 units)
and line height of 14 chars
rowHeightTest = (Range("M" & rowNum).Value * 14) / 40

'If theoretical number is greater than autofit number
If rowHeightTest Rows(rowNum & ":" & rowNum).RowHeight Then

'Failsafe if theoretical number is greater than max.
If rowHeightTest 409 Then rowHeightTest = 409
Rows(rowNum & ":" & rowNum).RowHeight = rowHeightTest
End If

'Clean up temp. cells and cycle to next cell
Range("M" & rowNum).ClearContents
rowNum = rowNum + 1
End If

Loop Until emptyRow = True

EggHeadCafe - Software Developer Portal of Choice
AJAX enabled web page design and beginner?s concept
http://www.eggheadcafe.com/tutorials...-page-des.aspx