Event macro for auto-fit row height of merged cells

[rackle]

I have the following code for auto-fitting the row height of a merged cell. I want the macro to run automatically after a user has entered text and have no experience writing this kind of macro (today is the first time I have actually created and run a macro) so I would need very basic instructions.


[VBA]''Simulates row height autofit for a merged cell if the active cell..
'' is merged.
'' has Wrap Text set.
'' includes only 1 row.
''Unlike real autosizing the macro only increases row height
'' (if needed). It does not reduce row height because another
'' merged cell on the same row may needed a greater height
'' than the active cell.
Sub AutoFitMergedCellRowHeight()
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 Sub [/VBA]

Regards,
Rackle

[Bob Phillips]

Use worksheet change

[vba]

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "H1:H5" '<<<< change to suit

On Error GoTo ws_exit

Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

'do your stuff here on Target
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub[/vba]

This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

[rackle]

is it supposed to look like this? I inserted my original code over the green target message.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "H1:H5" '<<<< change to suit

On Error GoTo ws_exit

Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

''Simulates row height autofit for a merged cell if the active cell..
'' is merged.
'' has Wrap Text set.
'' includes only 1 row.
''Unlike real autosizing the macro only increases row height
'' (if needed). It does not reduce row height because another
'' merged cell on the same row may needed a greater height
'' than the active cell.
Sub AutoFitMergedCellRowHeight()
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 Sub
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

[Bob Phillips]

No, you just insert the bit of code to work on a single row. I didn't look hard enough to try and figure it all out, I assumed you knew what it is doing.

[rackle]

I know nothing about this stuff. I have two codes now, my original code and one you have given me. I understand where to put yours but do I need to alter it based on what looks like instructions you inserted in green? Where do I put my original code?