The posted code is missing "Application.ScreenUpdating = False" at the
beginning and "Application.ScreenUpdating = True" at the end. Since you
implied you understand the code, I'll let you decide where to insert the
lines.

Greg

"Howard Kaikow" wrote:

I've seen a number of posts here and there that it is possible create one's
auto fit for
merged cells in a row to adjust cell height,

The logic is straightforward, but the execution is very slow.

Granted, I am using a 10 year old computer.
Yes, I will get another computer, indeed, I intend to build the critter and
purchased Win XP Pro SP@ on 15 April.

In any case, any ideas on how to speed up the code below.
On my old PC, it takes about 1 second to exceute the code for a cell merged
area.

Private Sub AutoFitMergeArea(rngSource As Excel.Range)
' Performs row height autofit for the MergeArea
' including rngSource

' Range must contain only 1 row.
' WrapText must be set to True.

' Row height is not reduced because other cells in the same row
' may need a greater height.

Dim MergedAreaWidth As Single
Dim NewRowHeight As Single
Dim rngCell As Excel.Range
Dim SourceWidth As Single
Dim SourceRowHeight As Single

With rngSource
If .MergeCells Then
MergedAreaWidth = 0#
SourceWidth = .Columns(1).ColumnWidth
If .Rows.count = 1 And .WrapText Then
SourceRowHeight = .RowHeight
For Each rngCell In rngSource
MergedAreaWidth = rngCell.ColumnWidth + MergedAreaWidth
Next rngCell
.MergeCells = vbFalse
.Cells(1).ColumnWidth = MergedAreaWidth
.EntireRow.AutoFit
NewRowHeight = .RowHeight
.Cells(1).ColumnWidth = SourceWidth
.MergeCells = vbTrue
If SourceRowHeight NewRowHeight Then
.RowHeight = SourceRowHeight
Else
.RowHeight = NewRowHeight
End If
End If
End If
End With
Set rngCell = Nothing
End Sub