Wrap Text with merge cells code
 

OK this is the code I have form my previous question he

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


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