Hello Jim,

Excellent macro.
I'm wondering if there's a way of doing this in multiple rows at once. Is this possible?

JC

I found this code and made improvement so it can support multiple cells selection. It's little bit tricky to deal with vertical oriented text but this code support it as well (small correction is required to switch off text wrapping in case of vertical text orientation, but I omit to do it - no more time). Code checks user selection and does not support entire rows our columns selection although it can work with it (just remove checking code). Thanks guys for starting code and my code version is the following:

Sub AutoFitMergedCellRowHeight()
Dim cell As Object
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim PrevMerge As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim FirstCell As Boolean
If Selection.Address = "$1:$1048576" Then
MsgBox ("This macro procedure for RowAutofit does not support entire rows or columns selection")
Exit Sub
End If
If Selection.Row 0 And Selection.count = Columns.count Then
MsgBox ("This macro procedure for RowAutofit does not support entire rows or columns selection")
Exit Sub
End If
If Selection.Column 0 And Selection.count = Rows.count Then
MsgBox ("This macro procedure for RowAutofit does not support entire rows or columns selection")
Exit Sub
End If
FirstCell = True
Set PrevMerge = Selection.Cells(1).MergeArea
For Each cell In Selection
If cell.MergeArea.Address < PrevMerge.Address Or FirstCell Then
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
CurrCell.Orientation = cell.MergeArea.Cells(1).Orientation
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)
CurrentRowHeight = 0
ActiveCellWidth = 0
MergedCellRgWidth = 0
PossNewRowHeight = 0
End If
End With
End If
Set PrevMerge = cell.MergeArea
Application.ScreenUpdating = True
FirstCell = False
Next cell
End Sub