简体   繁体   中英

Lock a cell if the adjacent cell is empty - Excel VBA

What I want to get is that if a cell in the range "D4: D14" is empty, the adjacent cell is locked. My code is the following but it doesn´t work:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range

    Set rng = Intersect(Range("D4:D14"), Target)

    If rng Is Nothing Then

    Else
        If IsEmpty(Target) Then
            rng.Offset(0, 1).Locked = True
        Else
            rng.Offset(0, 1).Locked = False
        End If
    End If
End Sub

What I want to get is that if a cell in the range "D4: D14" is empty , the adjacent cell is locked .

In your code if the cell is empty you are setting the .Locked property to False whereas I guess you want the opposite?

This works for me

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Dim aCell As Range

    Application.EnableEvents = False

    If Not Intersect(Range("D4:D14"), Target) Is Nothing Then
        ActiveSheet.Unprotect "MYPASSWORD" <~~ Change this to the actual password
        For Each aCell In Range("D4:D14")
            If Len(Trim(aCell.Value)) = 0 Then _
            aCell.Offset(, 1).Locked = True Else _
            aCell.Offset(, 1).Locked = False
        Next
        ActiveSheet.Protect "MYPASSWORD" <~~ Change this to the actual password
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Also ensure that the sheet is protected to see the effect of locked cells.

EDIT

The title of the question says

Unlock a cell if the adjacent cell is empty - Excel VBA

In such a case

            If Len(Trim(aCell.Value)) = 0 Then _
            aCell.Offset(, 1).Locked = True Else _
            aCell.Offset(, 1).Locked = False

becomes

            If Len(Trim(aCell.Value)) = 0 Then _
            aCell.Offset(, 1).Locked = False Else _
            aCell.Offset(, 1).Locked = True

NOTE: If the above code still doesn't work then type this in the Immediate window and press the enter key

Application.EnableEvents = True

在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM