Autofit with Merged Cells/Wrap Text Macro Problem

[Guest]

Hello,

I've attempted to utilize the frequently posted macro that Jim Rech wrote to
assist in this problem that all of us seem to run into at one point or
another. However, I keep getting a compile syntax error directing me to the
13th line of the macro.(MergedCellRgWidth = CurrCell.ColumnWidth +)

I have inserted this macro as a Module. Do I need to select the rows I need
done? Can anyone assist and where I may be going wrong?

Here's the full Module as I've inserted it:

Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RangeWidth As Single
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
RangeWidth = .Width
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
While .Cells(1).Width < RangeWidth
.Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
Wend
.Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub

 

[Guest]

If I could post an red-faced iicon, I would! No sooner did I post this
question did I see the break right where it said it was. One of those
"forest for the trees" moments, I suppose!! : )

Cheers,
Elf

 

[Guest]

One more question:
Do I have to select each cell individually and run the macro on each cell?
Is there no way to check the sheet all at once and run it for ANY merged/wrap
text cells?

Thanks in advance.
Elf

 

[Dave Peterson]

There's no good way to grab all the merged cells in a worksheet.

You can use specialcells to get formulas, constants, errors, comments, ...

But nothing like that can be done with merged cells.

You can pass the first cell of the mergedarea to Jim's routine, so you don't
have to select cells, too:

Option Explicit
Sub AutoFitMergedCellRowHeight(myActiveCell As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim OrigMergeArea As Range
Dim CurrCell As Range
Dim myActiveCellWidth As Single, PossNewRowHeight As Single
If myActiveCell.MergeCells Then
Set OrigMergeArea = myActiveCell.MergeArea
With myActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
myActiveCellWidth = myActiveCell.ColumnWidth
For Each CurrCell In OrigMergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = myActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub

Sub testme()

Dim myCell As Range
Dim myRng As Range

'limit the range as much as you can
Set myRng = Worksheets("Sheet1").UsedRange

For Each myCell In myRng.Cells
If myCell.MergeArea.Address = myCell.Address Then
'not merged, do nothing
Else
'only do the first cell in the merged area
If myCell.MergeArea.Cells(1).Address <> myCell.Address Then
Call AutoFitMergedCellRowHeight(myActiveCell:=myCell)
End If
End If
Next myCell
End Sub