Thread: Autofit row height

I have the following code which I am applying to an excel template.

Public Sub ReSizeRow()

If ActiveCell.MergeCells = False Then Exit Sub

With ActiveCell
.WrapText = True
.UnMerge
Rows(.Row).AutoFit
.RowHeight = .Width * .Height / Selection.Width
Selection.Merge
End With

End Sub

The problem is that the Autofit is only applying to the first row in the merged cell so I am still not managing to see all of the text entered.

The row height is at 129 pixels which I am presuming is the maximum and thats why I am having the problem.

Any suggestions

Thanks

Max

Edited to add attachment - the cells I want to expand depending on content is the 'Summary Field' and 'Full Details of Inspection Field'

The max row height in excel is 409pts

Length of cell contents (text) 32,767 characters. Only 1,024 display in a cell; all 32,767 display in the formula bar.

A quick check on one of your fields resulted in 1969 characters

This is probably where your problem arises

Check these helpful (?) M.S. sites, between them they seem to refer to a mix of 2003 & 2007 specs

http://office.microsoft.com/en-us/ex...005199291.aspx

http://office.microsoft.com/en-us/ex...010137545.aspx

@ maximoomoo

Hi Max,

I have been working to resize merged cells myself. I found some code that would do it for me however I couldn't get to run properly. Anyway after 2 days of pulling my hair out I stumbled across this code that works beautifully and automatically.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

just copy and past this code into your worksheet object.

Hope this helps

Windaroo