Merged cell height almost sovled but need help finishing

[RhodEvans]

Afternoon,In rows 20-34 I have got two merged cells B-E & F-J (I know no real programmer likes using merged cells, but the idoits using the spreadsheet get real confused if the sheet is not set up in a specific way). They are both 'free text' boxes so I need them to expand/contract in height to fit the text. I have managed to bastardise some code to do this (Vaguely). The problem is that I would like to be able to put it in the worksheet_selection change section. So when you cange cells it finds the 'fullest' out of the two merged cells in the row then put's the height to that one. I assume that it would be done using an IF statement, but can't quite wrap my head round how to get this to work.I have posted the code I have got below. If anyone can solve this you would make me, and from what I have seen round t'internet very happy indeed!!!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Const WS_RANGE As String = "B20:F34" '<<<< change to suit         On Error GoTo ws_exit         Application.EnableEvents = False         If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then                 With Target                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 With    End If     ws_exit:    Application.EnableEvents = TrueEnd Sub

 

[RhodEvans]

I'm almost there just need a hopefully simple push to get over the finishing line. I have now got the code to trigger from the following piece

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Const WS_RANGE As String = "B20:F34" '<<<< change to suitOn Error GoTo ws_exit'Application.EnableEvents = FalseIf Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing ThenDim LenValue As IntegerDim LenValuenext As IntegerWith Target'rhods bitLenValue = Len(ActiveCell)LenValuenext = Len(ActiveCell.Offset(0, 1))If LenValue > LenValuenext ThenCall heightElse: GoTo deadwooddeadwood:End If'end of rhod's bitEnd WithEnd Ifws_exit:'Application.EnableEvents = TrueEnd Sub

This checks the length of the text in the cell against the adjacent and only triggers the main row height bit if it has the most text in (To get the right hand column to check against the left. I have crudly put a formula in the next column across to paste the left hand columns text in).The original code in my last post I have altered to

Sub height()    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)                .RowHeight = PossNewRowHeight 'this row is changed            End If        End With    End IfEnd Sub

as the last one only made the height bigger, and not smallerThe only remining issue I have is that the code only seems to trigger if you click through the cells not if you type text in. Does anyone know how to alter the trigger code to do this?Thanks in advance as always.

 

[RhodEvans]

I thought I had it for a second before excel stubbornly decided that I was wrong and that it would continue to torture me. i tried putting the trigger code in the

Private Sub Worksheet_Change(ByVal Target As Range)

for the sheet. This not only does not trigger it from changing the cell, but will also not trigger when clicking on the cell.This is beginning to send me absolutly mental with a murderous (against both excel and myown stupidity for starting this) rage. So any help before I end up in a padded cell would be very very greatly received.

 

[sijpie]

AutoFit Merged Cell Row Height | Contextures Blog