Sleeper: Automatically set merged cell height
Hello
I have a problem with a macro that I have found and tries to use in my workbook.
It is a macro that will adjust the row height of merged cells. It works fine until I e.g. finds out that I wrote something wrong in the cell and want to delete it by pressing the delete key. Then I get into a runtime error. Anyone that can help me with that? Another thing I would like to have some help with is to "reset" the row hight if I decide to remove text that has been written in the merged cell. Is it possible to do that?
This is what i have in my worksheet:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Call AutoFitMergedCellRowHeight(Target)
End Sub
and this is the macro code in a module:
Code:
Sub AutoFitMergedCellRowHeight(Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RangeWidth As Single
Dim TargetWidth As Single, PossNewRowHeight As Single
If Target.MergeCells Then
With Target.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
TargetWidth = Target.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 = TargetWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub
Rgds
