Auto Re-Sizing Merged Cells
 

I have created a workbook with one sheet for inputting information, and
several other sheets containing the printed forms required for this job.

Some of these cells contain text, and the amount entered varies dramatically
from project to project. I therefor need to auto size the rows involved - and
have to use a macro as they are merged cells. The macro is run using the
change_worksheet private macro and is shown below. It works well for
individual cells, but I would like it to run on the corresponding cells in
the other worksheets when the cell on the input sheet is altered.

Any siggestions gratefully received.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("E12:R12")) Is Nothing Then
Exit Sub
Else
Range("E12:R12").Select
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 And .WrapText = True 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 If
End Sub

Auto Re-Sizing Merged Cells
 

The first line of the macro should read:

Private Sub Worksheet_Change(ByVal Target As Range)

I pasted a copy of a previous, failed, macro!!

"LongTermNoob" wrote:

I have created a workbook with one sheet for inputting information, and
several other sheets containing the printed forms required for this job.

Some of these cells contain text, and the amount entered varies dramatically
from project to project. I therefor need to auto size the rows involved - and
have to use a macro as they are merged cells. The macro is run using the
change_worksheet private macro and is shown below. It works well for
individual cells, but I would like it to run on the corresponding cells in
the other worksheets when the cell on the input sheet is altered.

Any siggestions gratefully received.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("E12:R12")) Is Nothing Then
Exit Sub
Else
Range("E12:R12").Select
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 And .WrapText = True 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 If
End Sub