Apply cell lock to only specific cells

[SRG61181]

I would like to apply the macro below only to cells B3, B6, B7, B8 leaving other cells open to editing.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim bl As Range
ActiveSheet.Unprotect Password:="1234"
For Each bl In Target
If bl.Value <> "" Then
check = MsgBox("Is this entry correct? This cell cannot be edited after entering a value.", vbYesNo, "Cel Lock Notification")
If check = vbYes Then
bl.Locked = True
Else
bl.Value = ""
End If
End If
Next bl
End If

ActiveSheet.Protect Password:="1234"

End Sub

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B3", "B6:B8")) Is Nothing Then Exit Sub
    ActiveSheet.Unprotect Password:="1234"
    If Target <> "" Then
        If MsgBox("Is this entry correct? This cell cannot be edited after entering a value.", vbYesNo, "Cel Lock Notification") = vbYes Then
            Target.Locked = True
        Else
            Target.Value = ""
        End If
    End If
    ActiveSheet.Protect Password:="1234"
End Sub