Autofit Merged Cells in Excel

[Guest]

I have tried to use Jim Rech's macro to autofit a merged cell in excel.
However, I cannot seem to get this to work for my situation. I have (1) row
merged in (2) columns (D & E.) What am I doing wrong???

 

[Jim Rech]

There are three requirements and you mentioned 2. Is Wrap Text set for the
active cell?

--
Jim Rech
Excel MVP
|I have tried to use Jim Rech's macro to autofit a merged cell in excel.
| However, I cannot seem to get this to work for my situation. I have (1)
row
| merged in (2) columns (D & E.) What am I doing wrong???

 

[Guest]

Yes, I do have wrap text selected.

 

[Jim Rech]

You didn't specify exactly how it fails. Just in case the problem is that
the macro is not shrinking the row height, I should mention it is design
only to increase row heights if needed. The reason being that there could
be other merged cells on the same row that need the greater row height.

Maybe you could copy/paste the problem merged cell into a new workbook and
send it to me, once you verify that the problem reproduces in it of course..

--
Jim Rech
Excel MVP
| Yes, I do have wrap text selected.
|
| "Jim Rech" wrote:
|
| > There are three requirements and you mentioned 2. Is Wrap Text set for
the
| > active cell?
| >
| > --
| > Jim Rech
| > Excel MVP
| > | > |I have tried to use Jim Rech's macro to autofit a merged cell in excel.
| > | However, I cannot seem to get this to work for my situation. I have
(1)
| > row
| > | merged in (2) columns (D & E.) What am I doing wrong???
| >
| >
| >

 

[Guest]

Jim,
The row height is not expanding to fit all the characters within the cell.
I am not very familar with macros. I just started working on them last week.
I don't mind sending you the workbook so you can look at it. How do I get
your email address?

 

[Jim Rech]

(e-mail address removed)
--
Jim Rech
Excel MVP
| Jim,
| The row height is not expanding to fit all the characters within the cell.
| I am not very familar with macros. I just started working on them last
week.
| I don't mind sending you the workbook so you can look at it. How do I get
| your email address?
|
| "Jim Rech" wrote:
|
| > You didn't specify exactly how it fails. Just in case the problem is
that
| > the macro is not shrinking the row height, I should mention it is
design
| > only to increase row heights if needed. The reason being that there
could
| > be other merged cells on the same row that need the greater row height.
| >
| > Maybe you could copy/paste the problem merged cell into a new workbook
and
| > send it to me, once you verify that the problem reproduces in it of
course..
| >
| > --
| > Jim Rech
| > Excel MVP
| > | > | Yes, I do have wrap text selected.
| > |
| > | "Jim Rech" wrote:
| > |
| > | > There are three requirements and you mentioned 2. Is Wrap Text set
for
| > the
| > | > active cell?
| > | >
| > | > --
| > | > Jim Rech
| > | > Excel MVP
| > | > | > | > |I have tried to use Jim Rech's macro to autofit a merged cell in
excel.
| > | > | However, I cannot seem to get this to work for my situation. I
have
| > (1)
| > | > row
| > | > | merged in (2) columns (D & E.) What am I doing wrong???
| > | >
| > | >
| > | >
| >
| >
| >

 

[Jim Rech]

Kelli's merged cell did not have word wrap set for the entire merged cell,
just the first cell in it. This is a situation I hadn't anticipated but an
easy shortcoming to fix (I think):

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 .Cells(1).WrapText = True Then
''<<.Cells(1) added
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
End Sub