D
dforgacs
I'm trying to autofit merged cells when the enter key is hit. It seems
excel moves the selected cell down one row when the enter key is hit
and the code runs on the next cell versus the original cell. My code is
below. Help!
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CurrentRowHeight As Single
Dim MergedCellRgWidth As Single
Dim CurrCell As Range
Dim RangeWidth As Single
Dim ActiveCellWidth As Single
Dim PossNewRowHeight As Single
If Target.MergeCells Then
ActiveCell.EntireRow.AutoFit
With Target.Resize(1, 1).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
End Sub
excel moves the selected cell down one row when the enter key is hit
and the code runs on the next cell versus the original cell. My code is
below. Help!
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CurrentRowHeight As Single
Dim MergedCellRgWidth As Single
Dim CurrCell As Range
Dim RangeWidth As Single
Dim ActiveCellWidth As Single
Dim PossNewRowHeight As Single
If Target.MergeCells Then
ActiveCell.EntireRow.AutoFit
With Target.Resize(1, 1).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
End Sub