I have the following code ina worksheet that wraps text in merged cells. I
also have some links from one cell to another to avoid entering text twice.
When I protect the sheet and try to enter text into the cell, I get the Run
Time error message 1004. I get an option to end or debug. If I debug, it
takes to the line in the code:

ma.MergeCells = False

I can click on End and then everything is OK. How do I modify the code so I
don't get the error please?

Thanks,

Gary

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

I don't know what's up with .MergeCells=False, it worked fine in a simple
test I just ran.

OT: Instead of this:

For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next

why not use MrgeWdth = ma.Width?

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______


"gwinder" wrote in message
...
I have the following code ina worksheet that wraps text in merged cells. I
also have some links from one cell to another to avoid entering text
twice.
When I protect the sheet and try to enter text into the cell, I get the
Run
Time error message 1004. I get an option to end or debug. If I debug, it
takes to the line in the code:

ma.MergeCells = False

I can click on End and then everything is OK. How do I modify the code so
I
don't get the error please?

Thanks,

Gary

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