How to lock (make read-only) a specific range based on a cell value?

Question

I'm working on a planning monitoring tool. I need to lock a range of cells based on a cell value.

I would like when the value in column "Q" is "Confirmed", then cells on the same row from Column M to Q are locked.

Sub planning_blocker()

    Dim last_row As Integer

    ' Compute the last row
    last_row = Worksheets("Planning").Cells(Rows.Count, 1).End(xlUp).Row
    Debug.Print last_row

    For i = 3 To last_row

        If Worksheets("Planning").Cells(i, 17).Value = "" Then
            Sheets("Planning").Range("M" & i & ":" & "P" & i).Locked = False
        
        Else
            Sheets("Planning").Range("M" & i & ":" & "P" & i).Locked = True
    
        End If
    
    Next i

    Sheets("Planning").Protect Password:="User"

End Sub

This works partially because:

it locks the entire row where "confirmed" is detected and not only the range
it consider only the first row where "confirmed" is detected and not the remaining ones (if more than one row is marked with "confirmed", only the first row is blocked).

score 0 · Answer 1 · answered Oct 16 '19 at 14:45

0

i tested your code and it works for me (Excel2016). the ranges (M:P) are locked if 17th column (col Q) of current row isn't empty. don't no what could be your problem here...

answered Oct 16 '19 at 14:45

Miguel Sanchéz

9
4

score 0 · Answer 2 · answered Oct 16 '19 at 18:13

Well, if you need to watch the status column for changes, I would suggest to use the Sub Worksheet_Change. this will trigger your code every time something changes in your sheet.

I made some changes to adapt your code and here is the result:

Sub Worksheet_Change(ByVal target As Range)
    Dim intesection As Range
    Dim rowIndex As Integer
    Set intesection = Intersect(target, Range("Q:Q"))

    'watch changes in intersection (column Q)
    If Not intesection Is Nothing Then
        'get row index of changed status
        rowIndex = Range(intesection.Address(0, 0)).Row

        If Cells(rowIndex, 17).Value = "" Then
            'unlock if status is blank
            ActiveSheet.Range("M" & rowIndex & ":" & "P" & rowIndex).Locked = False
            Call ActiveSheet.Protect(UserInterfaceOnly:=True, Password:="User")

        Else
            'lock if not blank
            ActiveSheet.Range("M" & rowIndex & ":" & "P" & rowIndex).Locked = True
            Call ActiveSheet.Protect(UserInterfaceOnly:=True, Password:="User")
        End If
    End If

End Sub

And you need to add this to the sheet where you have the table you want to lock/unlock.

Something like this:

Sources:

How to Lock the data in a cell

How to Tell if a Cell Changed

How to lock (make read-only) a specific range based on a cell value?

2 Answers2