Require password to delete entries

[chinaboy]

Good morning... I have a piece of code that should require a password prompt when a user attempts to delete data after entering it. But it doesn't seem to work. Ver new to this vba stuff. There is a range of cells I would like to restrict. Can you someone offer some suggestions on correcting it a better method to meeting my objective. The workbook is shared so trying to prevent other users from deleting someone on entry and to restrict deletion only to those that have the password.

Thanks in advance.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sPassCheck As String
    Dim rng As Range
    Dim sTemp As String
    Dim sPassword As String

    sPassword = "Password"
    sTemp = "Only members of the Management Team is authorized to delete an entry."
    'Use to set a single cell if more than one cell is
    'in the target range
    If Target.Count > 1 Then
        Set rng = Target.Cells(1, 1)
    Else
        Set rng = Target
    End If
    If rng.Value = "" Then
        sPassCheck = InputBox(sTemp, "Delete check!")
        Application.EnableEvents = False
        If sPassCheck <> sPassword Then Application.Undo
    End If
    Application.EnableEvents = True
End Sub

 

[RoryA]

What precisely does "doesn't seem to work" mean?

Is that code in the correct worksheet code module?

 

[chinaboy]

The code is currently in the ThisWorkbook in the Worksheet_Change.

Nothing happens when I try to delete existing data.

 

[gallen]

That code needs to be in the worksheet code module of the worksheet you want it to work on. It will not trigger from within the ThisWorkbook module.

 

[chinaboy]

Thank you... That did the trick.