Wrap Text code with merge cells
 

OK this is the code I have form my previous question he
It works great BUT has one problem. When it does its job and expends the row
to fit the text in one cell, then when I go to the next cell and type
something smaller it overwrights the first cell also. How can I fix this

CODE

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

ActiveSheet.Unprotect Password:="eli"
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

Range("B31:O98").Locked = False

With ActiveSheet
.Protect Password:="eli"
.EnableSelection = xlUnlockedCells
End With
End Sub