XL 2003 VBA: Protection Does Not Allow Row Deletion

[TechTank]

Hi,

I have the below macro assigned to a button on my worksheet:

Option Explicit
Sub Add_Prerequisite()
Dim rng As Range
    
Application.DisplayAlerts = False
Application.ScreenUpdating = False
        
        Sheets("Format Control").Range("B14").Value = _
        Sheets("Cover Sheet").Range("B23").Value
    With Sheets("Environment Information")
        .Unprotect
        Set rng = .Columns("A").Find(What:="2", After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, _
            MatchCase:=False, SearchFormat:=False)
        Sheets("Format Control").Rows(14).Copy
        rng.Offset(1).EntireRow.Insert
        rng.Offset(1, 2).Select
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
            AllowInsertingRows:=True, AllowDeletingRows:=True
    End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

However, it should but doesn't allow the user to delete a row after it has inserted.

Suspecting a code error I recorded the following while selecting what the user can and can't do in the "Protect my sheet" dialog box to compare and tried it again:

Option Explicit
Sub Macro1()

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowDeletingRows:=True
End Sub

Adding this second code to my original (top) macro still will not let the user delete the inserted row even though I've allowed it in the protection properties.

Can anyone point me to where I might be going wrong at all please?

Thank you for your time and any help.

 

[TechTank]

Hi Andrew,

I'll give that a try in the morning. Thank you for providing another reply though.

I've been using this as a work-around but your answer seems a lot simpler than calling a macro.

http://www.mrexcel.com/forum/showthread.php?t=578180

 

[TechTank]

Why don't you try?

ma.Locked = False

Hi Andrew,

Would I put that code in after this point:

     ma.MergeCells = True
    ma.RowHeight = NewRwHt

Thank you for your suggestion.

 

[Andrew Poulsom]

That seems the right place to put it.

 

[TechTank]

That seems the right place to put it.

Yet again you've come to my rescue. That did the trick and removed a problem I was having in this thread:

http://www.mrexcel.com/forum/showthread.php?t=579070

My code now looks like this and works a charm:

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
 
Application.ScreenUpdating = False
 
ActiveSheet.Unprotect
 
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
     ma.MergeCells = False
      c.ColumnWidth = MrgeWdth
       c.EntireRow.AutoFit
        NewRwHt = c.RowHeight
       c.ColumnWidth = cWdth
     ma.MergeCells = True
    ma.RowHeight = NewRwHt
    ma.Locked = Flase
   cWdth = 0: MrgeWdth = 0
End If
End With
 
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowInsertingRows:=True, AllowDeletingRows:=True
        
Application.ScreenUpdating = True
 
End Sub

You're like my VBA Guardian Angel, thank you very much.

 

[Andrew Poulsom]

There's a typo there:

ma.Locked = Flase

 

[TechTank]

There's a typo there:

ma.Locked = Flase

Indeed there is...must've knocked it about when I pasted it in. Well spotted. Please find the correct working code below:

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
 
Application.ScreenUpdating = False
 
ActiveSheet.Unprotect
 
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
     ma.MergeCells = False
      c.ColumnWidth = MrgeWdth
       c.EntireRow.AutoFit
        NewRwHt = c.RowHeight
       c.ColumnWidth = cWdth
     ma.MergeCells = True
    ma.RowHeight = NewRwHt
    ma.Locked = False
   cWdth = 0: MrgeWdth = 0
End If
End With
 
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowInsertingRows:=True, AllowDeletingRows:=True
        
Application.ScreenUpdating = True
 
End Sub