Thanks very much for your help. The Adding break line helped me find out where the code was going wrong. I can't believe that I didn't know about this method until now!
The issue with it was the fact that the code exceuted when return was hit, this meant that it was trying to resize the cell in the row below rather than the correct one.
I have attached the correct trigger code, and the correct resize code below for anyone who needs it. Hope that it helps.
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B20:F34" '<<<< change to suit
On Error GoTo ws_exit
Application.EnableEvents = True
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Dim LenValue As Integer
Dim LenValuenext As Integer
With Target
'rhods bit
LenValue = Len(ActiveCell.Offset(-1, 0)) 'changed this line to compare the row above
LenValuenext = Len(ActiveCell.Offset(-1, 1)) 'and this one too
If LenValue > LenValuenext Then
Call height
Else: GoTo deadwood
deadwood:
End If
'end of rhod's bit
End With
ws_exit:
End If
'Application.EnableEvents = True
End Sub
And the resize code
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.Offset(-1, 0).MergeArea 'changed this line to work on the one above
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 + 3 'added a bit of a buffer in here to make the cells more readable
End If
End With
End If
End Sub
Bookmarks