B
bluegrassstateworker
I am missing something... I have the following code below in a module
(Excel-Office2003) obtained from an earlier posting. The merged area
should autoresize when I input information into the merged cell and
hit the enter key but it is not. The code does work fine if I make it
a public function then run it on the cell itself. You can see from
the first line made into a comment my testing method. Other "ByVal"
change testings work fine: I make the change and the code is activated
on that cell when I hit the enter key.
Thanks
**********************************************************
'Sub AutoFitMergedCellRowHeight()
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
(Excel-Office2003) obtained from an earlier posting. The merged area
should autoresize when I input information into the merged cell and
hit the enter key but it is not. The code does work fine if I make it
a public function then run it on the cell itself. You can see from
the first line made into a comment my testing method. Other "ByVal"
change testings work fine: I make the change and the code is activated
on that cell when I hit the enter key.
Thanks
**********************************************************
'Sub AutoFitMergedCellRowHeight()
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