B
bluegrassstateworker
I have the macro developed by Jim Rech, will adjust the height of a
merged/wrapped cell in a single row and have changed it from :
Sub AutoFitMergedCellRowHeight()
* code here *
end sub
To:
Private Sub Worksheet_Change(ByVal Target As Range)
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 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
End Sub
This is to activate the macro automatically when the merged cells are
changed and the enter key is pressed but it is not working. It is
located in a module and other test code will run successfully. Office
2003. What am I missing?
merged/wrapped cell in a single row and have changed it from :
Sub AutoFitMergedCellRowHeight()
* code here *
end sub
To:
Private Sub Worksheet_Change(ByVal Target As Range)
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 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
End Sub
This is to activate the macro automatically when the merged cells are
changed and the enter key is pressed but it is not working. It is
located in a module and other test code will run successfully. Office
2003. What am I missing?