Row height

[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?

 

[Guest]

Hi,

You'll need to move the Worksheet_Change sub out of the Module and put it in
the worksheet code module....

 

[bluegrassstateworker]

Hi,

You'll need to move the Worksheet_Change sub out of the Module and put it in
the worksheet code module....

--
Hope that helps.

Vergel Adriano





- Show quoted text -

I have put this into the Worksheet module without success. Any other
ideas?

 

[bluegrassstateworker]

I have put this into the Worksheet module without success. Any other
ideas?- Hide quoted text -

- Show quoted text -

Thanks to Jim Rech for the solution! Something to share with
everyone.
The source of failure we found in my case was that upon hitting the
enter key, the focus was being changed from the cell to where the
cursor would go after hitting the enter key and not where it was.
This was because my system was using the default setting to go to the
right on pressing the enter key. If you go into TOOLS | OPTIONS |
Edit tab | Move Selection After Enter, you will see your setting. The
below code works around that so any setting is possible AND if there
are any new worksheets created with a merged cell and text wrap, it
will work on all cells.

Here is what Jim did:
This code was put in the "This Workbook" module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
AutoFitMergedCellRowHeight Target
End Sub

Then he put the following code in a module:

Sub AutoFitMergedCellRowHeight(Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Set Target = Target.Cells(1) ''In case several cells are changed
at once
If Target.MergeCells Then
With Target.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = Target.ColumnWidth
For Each CurrCell In .Cells
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