Wrap text doesn't work when sheet is protected
 

I have been working on a employee review form that has unlocked merged cells.
I have the following event code that fires when there is no sheet
protection. However, as soon as I protect the sheet, the code doesn't fire.
If I unprotect after the text has been entered, then it will fire. Am I
missing something in the follwing code?

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
On Error Resume Next
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
On Error GoTo 0
Application.ScreenUpdating = True
End If
End With
End Sub

Wrap text doesn't work when sheet is protected
 

In youprotection statement have you included "Format Cells"?
--
Best wishes,

Jim


"gwinder" wrote:

I have been working on a employee review form that has unlocked merged cells.
I have the following event code that fires when there is no sheet
protection. However, as soon as I protect the sheet, the code doesn't fire.
If I unprotect after the text has been entered, then it will fire. Am I
missing something in the follwing code?

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
On Error Resume Next
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
On Error GoTo 0
Application.ScreenUpdating = True
End If
End With
End Sub

Wrap text doesn't work when sheet is protected
 

If it's protected, you can unprotect it then reprotect it in the code. If you
are using a password you will have to hard code it. If you then want to
change the password you will also have to change the code. In place of the
word "password" insert your password (two locations) and remove the leading
apostrophes:

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
Dim ProtectStatus As Boolean

With Target
If .MergeCells And .WrapText Then
ProtectStatus = Me.ProtectContents
If ProtectStatus Then Me.Unprotect ' "password"
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
On Error Resume Next
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
On Error GoTo 0
Application.ScreenUpdating = True
If ProtectStatus Then Me.Protect ' "password"
End If
End With
End Sub

Regards,
Greg