Merged Cells Autofit Macro Code
 

I got the following code from elsewhere on the site and I am not real
familiar with Macros. The code runs without any errors, but it does nothing
to the merged cells that I want to expand to show all the characters in them.

Can someone give me a Macro primer?

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
--
Thanks

You all are teaching me so much

Merged Cells Autofit Macro Code
 

This portion of the code:
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then

Checks to see that the activecell is merged -- but is exactly 1 row high. If
you've merged multiple rows (and columns), then the code won't do the work.

It also checks to see if you have that cell formatted to wrap text. If you
don't, then the code won't do the work.

And at the bottom of the procedure, this code:

.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)

Checks to see if the rowheight should be changed. If the current rowheight is
larger than the calculated rowheight, then the code doesn't do anything.

So the questions become more about what the activecell contains and how it's
formatted.


knowshowrosegrows wrote:

I got the following code from elsewhere on the site and I am not real
familiar with Macros. The code runs without any errors, but it does nothing
to the merged cells that I want to expand to show all the characters in them.

Can someone give me a Macro primer?

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
--
Thanks

You all are teaching me so much

--

Dave Peterson