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.

 

[Andrew Poulsom]

For the user to be able to delete a row all cells in it must be unlocked. That's the message I got from Excel when I tried it.

 

[Kenneth Hobson]

I showed how to do this sort of things with columns. There was no need to unprotect the sheet.
http://www.ozgrid.com/forum/showthread.php?t=157372

 

[TechTank]

For the user to be able to delete a row all cells in it must be unlocked. That's the message I got from Excel when I tried it.

It would seem "idiot" would be a good title for me on this occasion! In my Format Control Sheet it would seem I hadn't unlocked some cells to enable this to happen.

And commenting out this might have helped:

Application.DisplayAlerts = False

Andrew, you've saved my sanity again and I'm hoping this code-blindness has now gone. Awesome VBA skills, I think you've replied to every one of my questions

Regards,

Mark.

 

[TechTank]

Hi,

Further to the above I added the following into the sheet code but the scenario I get is this:

When I add several lines to the same cell (using ALT+ENTER) and then tab to the next cell the cell I was typing in that has had it's row height "auto-fitted" by the following code becomes locked for some reason:

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
   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

I added the ActiveSheet.Unprotect and .Protect parts in myself as the code would not run while the sheet was protected.

Can anyone tell me why please as this is preventing users from deleting the row should they need to.

Thank you for reading and for you time.

 

[Andrew Poulsom]

I don't know why the cell is being locked, but why don't you unlock it in your code?

 

[TechTank]

I thought I had with this line:

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

This might be an eureka moment but is it this part I need to remove:

Contents:=True,

Thank you for replying.

 

[TechTank]

I tried the above and the checked the cells properties. The cell's 'Locked' box was green but not with a tick to I can only guess that it is partially locked. the above\below code did little but I suspected it might do that.

I thought I had with this line:

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

This might be an eureka moment but is it this part I need to remove:

Contents:=True,

Thank you for replying.

Ah the complexities of Excel and VBA

 

[TechTank]

I have removed protection on the sheet and typed some information into the cell and used ALT+ENTER to add another line within the same cell. When I press TAB the code below activates and seems to lock (Not the green tick on the Locked box but a green square) just the one cell that I am typing into.

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

 

[Andrew Poulsom]

Why don't you try?

ma.Locked = False