Autofit doesn't work when column not enough width
 

Hi !
I have modify the original "AdjustRowHeight" for merged cells to apply to
all cells in a specific table range. Sometimes, when column width are not
enought large, the EntireRow.AutoFit command doesn't work. Does anyone have a
solution for this kind of problem ?
Is it possible to have a macro that replace the Autofit line ?
What I could do is to enlarge each table column (+1), make autofit and then,
resize column width to original value.

Excel seems to required a little space after the end of the last character.

Thank you.

Here is my program.
Sub AdjustRowHeight()
Dim myRange As Range
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim j As Long
Dim myCell As Cells

'1- Verify if there is a table in the ActiveSheet
myTable = Array("table1_1", "table1_2", "table2_1", "table2_2", "table2_3",
"table3_1", "table3_2")
On Error Resume Next
i = -1
Do Until Not myRange Is Nothing Or i = 7
i = i + 1
Set myRange = ActiveSheet.Range(myTable(i)) 'Local Range Only
Loop
If i = 7 Then Exit Sub

'2- Adjust Row Height
myRange.EntireRow.AutoFit = True
For Each cell In myRange
MergedCellRgWidth = 0
If cell.MergeCells And cell = cell.MergeArea.Cells(1) Then 'Treatment
for first merge cell only
With cell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = cell.ColumnWidth
For Each CurrCell In cell.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next cell
End Sub
--
Alex St-Pierre

Autofit doesn't work when column not enough width
 

Hi,
Try to expand the row height to a large number before autofit, eg:
Rg.EntireRow.RowHeight=400
Rg.EntireRow.Autofit

--
Regards,
Sébastien
<http://www.ondemandanalysis.com


"Alex St-Pierre" wrote:

Hi !
I have modify the original "AdjustRowHeight" for merged cells to apply to
all cells in a specific table range. Sometimes, when column width are not
enought large, the EntireRow.AutoFit command doesn't work. Does anyone have a
solution for this kind of problem ?
Is it possible to have a macro that replace the Autofit line ?
What I could do is to enlarge each table column (+1), make autofit and then,
resize column width to original value.

Excel seems to required a little space after the end of the last character.

Thank you.

Here is my program.
Sub AdjustRowHeight()
Dim myRange As Range
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim j As Long
Dim myCell As Cells

'1- Verify if there is a table in the ActiveSheet
myTable = Array("table1_1", "table1_2", "table2_1", "table2_2", "table2_3",
"table3_1", "table3_2")
On Error Resume Next
i = -1
Do Until Not myRange Is Nothing Or i = 7
i = i + 1
Set myRange = ActiveSheet.Range(myTable(i)) 'Local Range Only
Loop
If i = 7 Then Exit Sub

'2- Adjust Row Height
myRange.EntireRow.AutoFit = True
For Each cell In myRange
MergedCellRgWidth = 0
If cell.MergeCells And cell = cell.MergeArea.Cells(1) Then 'Treatment
for first merge cell only
With cell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = cell.ColumnWidth
For Each CurrCell In cell.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next cell
End Sub
--
Alex St-Pierre

Autofit doesn't work when column not enough width
 

Hi Sebastien,

It doesn't work. What I have is the following:
Cells(1,1) and Cells(1,2) are merged + wraptext (takes 2 rows height)
Cells(1,3) contains a text that fit on one row (column width = 12 - autofit
gives 12,25)
When I execute the macro, the height becomes 26,25 as expected.
Then, if I delete the Cells(1,1) and try to autofit the row, it still stay
at 26,25.
If I execute the Macro, it gives the same result.
To make the autofit (or macro) working, I have to do the following:
1) Go in cells(1,3) property and unclick "Wrap Text"
Or
2) Autofit column 3 to have 12,25 width

I don't understand why autofit doesn't work well with wrap text ?

Thanks!

--
Alex St-Pierre


"sebastienm" wrote:

Hi,
Try to expand the row height to a large number before autofit, eg:
Rg.EntireRow.RowHeight=400
Rg.EntireRow.Autofit

--
Regards,
Sébastien
<http://www.ondemandanalysis.com


"Alex St-Pierre" wrote:

Hi !
I have modify the original "AdjustRowHeight" for merged cells to apply to
all cells in a specific table range. Sometimes, when column width are not
enought large, the EntireRow.AutoFit command doesn't work. Does anyone have a
solution for this kind of problem ?
Is it possible to have a macro that replace the Autofit line ?
What I could do is to enlarge each table column (+1), make autofit and then,
resize column width to original value.

Excel seems to required a little space after the end of the last character.

Thank you.

Here is my program.
Sub AdjustRowHeight()
Dim myRange As Range
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim j As Long
Dim myCell As Cells

'1- Verify if there is a table in the ActiveSheet
myTable = Array("table1_1", "table1_2", "table2_1", "table2_2", "table2_3",
"table3_1", "table3_2")
On Error Resume Next
i = -1
Do Until Not myRange Is Nothing Or i = 7
i = i + 1
Set myRange = ActiveSheet.Range(myTable(i)) 'Local Range Only
Loop
If i = 7 Then Exit Sub

'2- Adjust Row Height
myRange.EntireRow.AutoFit = True
For Each cell In myRange
MergedCellRgWidth = 0
If cell.MergeCells And cell = cell.MergeArea.Cells(1) Then 'Treatment
for first merge cell only
With cell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = cell.ColumnWidth
For Each CurrCell In cell.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next cell
End Sub
--
Alex St-Pierre

Problem seems to be Cells(1,3)
 

Hi !
Problem seems to be Cells(1,3)
column width=11.86 (takes 2 rows height) All the time
column width=12 (takes 1 row height but autofit gives 2 rows height) - If
WrapText
column width=12 (takes 1 row height but autofit gives 1 row height) -If Not
Wrap
column width=12.25 (takes 1 row height and 1 row height) All the time
I don't know what wrap is doing but seems to take a bit more space.

--
Alex St-Pierre


"Alex St-Pierre" wrote:

Hi Sebastien,

It doesn't work. What I have is the following:
Cells(1,1) and Cells(1,2) are merged + wraptext (takes 2 rows height)
Cells(1,3) contains a text that fit on one row (column width = 12 - autofit
gives 12,25)
When I execute the macro, the height becomes 26,25 as expected.
Then, if I delete the Cells(1,1) and try to autofit the row, it still stay
at 26,25.
If I execute the Macro, it gives the same result.
To make the autofit (or macro) working, I have to do the following:
1) Go in cells(1,3) property and unclick "Wrap Text"
Or
2) Autofit column 3 to have 12,25 width

I don't understand why autofit doesn't work well with wrap text ?

Thanks!

--
Alex St-Pierre


"sebastienm" wrote:

Hi,
Try to expand the row height to a large number before autofit, eg:
Rg.EntireRow.RowHeight=400
Rg.EntireRow.Autofit

--
Regards,
Sébastien
<http://www.ondemandanalysis.com


"Alex St-Pierre" wrote:

Hi !
I have modify the original "AdjustRowHeight" for merged cells to apply to
all cells in a specific table range. Sometimes, when column width are not
enought large, the EntireRow.AutoFit command doesn't work. Does anyone have a
solution for this kind of problem ?
Is it possible to have a macro that replace the Autofit line ?
What I could do is to enlarge each table column (+1), make autofit and then,
resize column width to original value.

Excel seems to required a little space after the end of the last character.

Thank you.

Here is my program.
Sub AdjustRowHeight()
Dim myRange As Range
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim j As Long
Dim myCell As Cells

'1- Verify if there is a table in the ActiveSheet
myTable = Array("table1_1", "table1_2", "table2_1", "table2_2", "table2_3",
"table3_1", "table3_2")
On Error Resume Next
i = -1
Do Until Not myRange Is Nothing Or i = 7
i = i + 1
Set myRange = ActiveSheet.Range(myTable(i)) 'Local Range Only
Loop
If i = 7 Then Exit Sub

'2- Adjust Row Height
myRange.EntireRow.AutoFit = True
For Each cell In myRange
MergedCellRgWidth = 0
If cell.MergeCells And cell = cell.MergeArea.Cells(1) Then 'Treatment
for first merge cell only
With cell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = cell.ColumnWidth
For Each CurrCell In cell.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next cell
End Sub
--
Alex St-Pierre