Excel ticking "Locked" for cells when I dont want it to

Martyn12

New Member
Joined
Jun 28, 2015
Messages
27
Hi
I have a spreadsheet for recording issues, when complete we update cell in column "M", VB will then set each cell for the row to locked. this then prevents the row from being edited, the rest remain editable.

however i am now finding that cells that start off with Locked un-ticked are now ticked an now have to unprotect the sheet.

I have checked through the VB but cannot see why it is doing this, code below.

hope someone can see where i have gone wrong.

Many Thanks

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
'have something to so first unprotect sheet
    ActiveSheet.Unprotect ("password")
' make sure the "Y" is changed to upper case in columns "M" (keeps it neat)
If Not (Application.Intersect(Target, Range("M7:M306")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                .Offset(0, 1).Value = Now
                .Offset(0, 2).Value = Environ("username")
                Application.EnableEvents = True
            End If
        End With
    End If
    
    Dim rowId As Long
    
    'check in the area that was change contains at least one cell from M1:M1005 or Z1:W306
    If (Intersect(Target, Union(Range(Cells(1, "M"), Cells(306, "M")), Range(Cells(1, "Z"), Cells(306, "Z")))) Is Nothing) Then
        ' no match, so nothing to do
        Exit Sub
    End If
    
    'have something to so first unprotect sheet
    ActiveSheet.Unprotect ("password")
    
    'the email code may need to go in between this section
    'for each row that have been modified, check
    For Each Row In Target.Rows
        rowId = Row.Row
    
        'check lock/unlock cells A:M
        Range(Cells(rowId, "A"), Cells(rowId, "M")).Locked = (Cells(rowId, "M") = "Y")
    
        'check lock/unlock cells N:W
        Range(Cells(rowId, "N"), Cells(rowId, "Y")).Locked = (Cells(rowId, "M") = "Y")
    Next

    ActiveSheet.Protect ("password"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
 , AllowFiltering:=True
 ActiveSheet.EnableSelection = xlUnlockedCells
 
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimit As Double
    Dim MyDate As Date
    NotSentMsg = " "
    SentMsg = "Sent"
    'Above the MyLimit value it will run the macro
    MyLimit = 2
    'Un lock Sheet (add a password here)
    ActiveSheet.Unprotect ("password")
    'Set the range with Formulas that you want to check
    Set FormulaRange = Me.Range("W7:W306")
    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = "error no numeric value"
            Else
                If .Value > MyLimit Then
                    MyMsg = SentMsg
                     If .Offset(0, 1).Value = NotSentMsg Then
                        Call Mail_with_outlook
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            Application.EnableEvents = False
                        .Offset(0, 1).Value = MyMsg
            If MyMsg = "Sent" And .Offset(0, 2).Value = "" Then
        .Offset(0, 2).Value = Now
                
    End If
            Application.EnableEvents = True
            
        End With
    Next FormulaCell
    
    'Lock Spreadsheet (add same password as above)
ActiveSheet.Protect ("password"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
 , AllowFiltering:=True
 ActiveSheet.EnableSelection = xlUnlockedCells
 
ExitMacro:
    Exit Sub
EndMacro:
    Application.EnableEvents = True
    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description
  Application.ScreenUpdating = True
End Sub
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Yes I was, all the cells hhave been un-ticked for Locked.

interstingly, I just highlighted al the cells, un-ticked "Locked", saved (checked could still edit) closed workbook and reopened, and all the cells where locked, could be the VB that is dong this.
 
Last edited:
Upvote 0
The first thing you do in the change macro is to unprotect the sheet. If the cell being changed is not in the intersect ranges then the macro exits without reprotecting the sheet. Is that what you mean?
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top