CODEWITHSUNDEEP
excelvba
Daniel Shaffer
Daniel Shaffer

Reputation: 3

How Can You Lock Rows of Cells in Excel Based on Cell Value?

So I know that one can format cells to be locked and then protect a worksheet to prevent that data being overwritten. But I'm looking to be able to dynamically lock cells within a sheet. From doing some Googling I've tried adapting the below block of code for my needs. The intent is that if column A has a value the rest of the row will be locked so no one can overwrite the rest of the row.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(ActiveSheet.Cells(18, 1), Target) Is Not Nothing Then
        If ActiveSheet.Cells(18, 1).Text = "X" Then
            ActiveSheet.Range(Cells(18, 2), Cells(18, 20)).Locked = True
        Else
            ActiveSheet.Range(Cells(18, 2), Cells(18, 20)).Locked = False
        End If
    End If
End Sub

Any help would be much appreciated, as well as tips for succinctly applying this to every row in the sheet.

UPDATE:

Per BigBen's answer I've revised to the following:

Private Sub Workbook_Open()
    Sheets(“Sheet8”).Protect Password:="Secret", UserInterFaceOnly:=True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Me.Columns(1), Target)

    If rng Is Nothing Then Exit Sub

    Dim cell As Range
    For Each cell In rng
        cell.EntireRow.Locked = (cell.Value = "X")
    Next
End Sub

But that still doesn't seem to be working...

Upvotes: 0

Views: 1236

Answers (1)

BigBen
BigBen

Reputation: 49998

You need to change the Intersect to test if Target intersects column A, and not a particular cell:

Note also the Not syntax: If Not Intersect... Is Nothing, instead of If Intersect... Is Not Nothing.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Me.Columns(1), Target) Is Nothing Then
        Dim rng as Range
        For Each rng in Intersect(Me.Columns(1), Target)
            If rng.Value = "X" Then
                rng.EntireRow.Locked = True
            Else
                rng.EntireRow.Locked = False
            End If
        Next
    End If
End Sub

Or perhaps a bit more succinctly:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Me.Columns(1), Target)

    If rng Is Nothing Then Exit Sub

    Dim cell As Range
    For Each cell In rng
        cell.EntireRow.Locked = (cell.Value = "X")
    Next
End Sub

Upvotes: 1

Related Questions