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!!!
Code:
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