Hi, In my spreadsheet I must have 7 columns in the first 20 rows. For the remaining rows below that I need only 4 columns.

So for rows 21 onwards, Columns 2 and 3 have to be merged to give me sufficient width for the text input. I can not have this text word wrap.

Columns 4 to 7 have to be merged to give me one cell for "lengthy comments". The comments can extend to as much as two or three lines so word wrap is essential here.

I copied this code below from a contributor whose name I can not remember so apologies for not acknowledging the source by name. It works fine except that: I enter short text in say row 25, merged column 2&3. I then enter longer text in row 25, merged column 4to7 and it wraps correctly.
Now I go back to merged column 2&3 and replace the contents, again with short text. The entire row height is now reduced to that of single line height which causes the text in row 25, merged column 4to7 to lose its wrap text feature.

Can the code be modified so that the row height always stays high enough to show the longest word wrapped text entry of the row?
Many thanks for any help.
Roger

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub