You can try this untested modification and see if it helps.

Sub AutoFitMergedCellRowHeight()
Dim cell as Range, rng as Range
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
for each cell in Selection
if rng is nothing then
set rng = cell.MergeArea
else
if Intersect(rng,cell.MergeArea) is nothing then
if cell.MergeCells then
set rng = union(rng,cell.MergeArea)
end if
end if
end if
if rng is nothing then exit sub
for each cell in rng.Areas
cell.select
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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
End Sub

--
Regards,
Tom Ogilvy


"Darin Kramer" wrote in message
...
Hi guys,

I have a macro (see Below) that works when you run it, BUT ONLY runs on
the currently selected cell.
I need it to run over the entire spreadsheet (or preferably over a range
that I specify, say A5:s100 - there are several sheets and ranges
though...)

Please can someone help....

Kind Regards

Darin


Sub AutoFitMergedCellRowHeight()

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!