Autofit merged cells

[Per_]

Hello,

I have searched the forum after som code that deals with wrap text on merged cells. I have found some but nobody seams to work for me .

The backgroud:

I have one row of cells:
Group1: A1:C1 are merged
Group2: F1:G1 are merged
Group3: I1:K1 are merged

I would like to autofit(wraptext) the text in the three groups just like if the cells where not merged. So if group 1 fits on one row and group 2 fits on two rows, two rows should be visable.

I hope anybody coudl help me!

Thanks Per

 

[Per_]

Set c = Range("A1")
c.EntireRow.AutoFit
NewRwHt = c.RowHeight

is it possible to run c.EntireRow.AutoFit but not change anything in excel sheet ? To get the height without change anything.

 

[Per_]

Please help!

 

[Andrew Poulsom]

Use the alignment 'Center Across Selection' instead of merging and wrap the text. The row height will then autofit.

 

[Per_]

Where can I find that option ? It that the same as merge ?

 

[Andrew Poulsom]

Its under Format Cells|Alignment tab|Horizontal dropdown.

 

[Per_]

Thanks. But you could still select individual cells after doing that

 

[Andrew Poulsom]

You can't have AutoFit with merged cells:

http://support.microsoft.com/kb/212010

 

[RecklessHate]

Try using this

Sub AutoHeightMergedCells()
With Selection
.MergeCells = False
.HorizontalAlignment = xlCenterAcrossSelection
.WrapText = True
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
End With
End Sub

 

[Ashirra]

it's an old post, but if someone else stumbles over this post it might be helpful.

I use this in a lot of my workbooks.

Sub AutoFitMergedCellRowHeight(cell As Range)
Dim b1 As Single, b2 As Single, h1 As Single, h2 As Single, newRowHeigt As Single
Dim lines As Integer
Dim mergeRng As Range
    
    If cell.MergeCells Then
        With cell.MergeArea
            
            Set mergeRng = cell.MergeArea
                    
            'get width of merged area
            b2 = cell.MergeArea.width
            
            'unmerge and unwrap
            .MergeCells = False
            .WrapText = False
            .EntireRow.AutoFit
            h1 = cell.RowHeight
            b1 = cell.ColumnWidth
            'set the topleftcell to the width of the merged area
            cell.ColumnWidth = (cell.ColumnWidth / cell.width) * b2
            
            'wrap and autofit
            .WrapText = True
            .EntireRow.AutoFit
            
            'get height with wrap and autofit on topleftcell
            h2 = cell.RowHeight
            
            'reset to merged
            'set back width of topleftcell to orginal size
            cell.ColumnWidth = b1
            mergeRng.merge
            
            'calculate lines
            lines = h2 / h1
            
            'calculate and set hight
            mergeRng.RowHeight = h1 * lines / mergeRng.Rows.Count
            
        End With
    End If


End Sub