Lock cells that meets specific criteria


Hi guys :)

Am sharing an excel sheet with my colleagues. Am using 5 columns with remarks on the 5th. For the security of data, I want the non-empty cells to be locked once I input the word "final" on the 5th cells.

Is it possible to excel?

Thanks in advance :)



Thank you so much Variatus.. 

However I pasted the code in the code sheet of the worksheet but for some reasons, the code is not working.

Am not that good in Macros or Vba thus, i cannot determine what the problem was. 

To describe, the vba window is asking for a "Macro Name". When I entered a macro name, the "Sub MacroName()" appeared. I pasted your code after "Sub MacroName()" then error occurs.

Hope you could help me on this issue.

Thanks in advance :)

crisanto_suratos (rep: 2) Oct 26, '17 at 10:43 pm
No idea. Make sure that you did indeed paste the entire macro, including its name.  After which action did the VB Editor ask for a macro name?
Variatus (rep: 2354) Oct 26, '17 at 10:54 pm
Hi Variatus

I know its too much but am really interested with the code you sent a while ago. Can you send a sample file at crisanto.suratos@gmail.com wherein this code applies?

Thank you very much :)
crisanto_suratos (rep: 2) Oct 27, '17 at 4:02 am
Add to Discussion


Selected Answer

If you install this code in the code sheet of the worksheet on which you have your final data, you must save the workbook as macro-enabled.

Option Explicit
    Dim PrevValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 27 Oct 2017
    PrevValue = Target.Cells(1).Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    ' 27 Oct 2017
    Dim Rng As Range
    Dim Refuse As Boolean
    Dim R As Long
    With Target
        ' allow changes in row 1 / take no action if ...
        ' Cell was previously blank or column 5 is included in the selection
        Set Rng = Cells(.Row, 5)
        If (.Row < 2) Or (Len(PrevValue) = 0) Or _
           (Not Application.Intersect(Target, Rng) Is Nothing) Then
            Exit Sub
        End If
        For R = 0 To .Rows.Count - 1
            Refuse = (StrComp(Cells(.Row + R, 5).Value, "Final", vbTextCompare) = 0)
            If Refuse Then Exit For
        Next R
        If Refuse Then
            ' catches changes in columns 1 to 4 (= A:D)
            Set Rng = Range(Cells(.Row, 1), Cells(.Row, 4))
            If Not Application.Intersect(Target, Rng) Is Nothing Then
                MsgBox "This row has final data." & vbCr & _
                       "No modification permitted." & vbCr & _
                       "Your change will be undone.", _
                       vbInformation, "Invalid modification"
                With Application
                    .EnableEvents = False
                    .EnableEvents = True
                End With
            End If
        End If
    End With
End Sub

The code will detect any change made in columns A:D. If column E has the word "Final" in it ("final" "FINAL" or "fINAL" will also work) any change made by the user will be undone after displaying a message.

If the user selects multiple cells, modification will be refused if any one of them had "Final" in column 5 (=E). However, if column 5 is included in the selected range no objection will be raised.



I have improved the code, most notably to allow modification of blank cells even if the row is marked as final and to reject multiple row deletions unless the "Final" column is included. I also attach a workbook with functioning code installed. You may like to delete your email adress from your previous post. I have taken note of it in case it may still be needed :-)
Variatus (rep: 2354) Oct 27, '17 at 6:45 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login