Drop-down password

[Maschine10]

Hello everybody,

I'm currently facing an issue with the Dropdown-lists.
I managed to allow that each requester in the dropdown list needs to type in there own password to be able to select there names.
But I want the whole sheet to be protected, until you select your name. After which you are allowed to fill in data in a selected area.

I used the following code:

Option Explicit
Const Marc As String = "Marc1"
Const Nina As String = "Nina1"
Const Lars As String = "Lars1"
Const Ibo As String = "Ibo1"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim pwd As String
Dim Oops As Boolean

Application.EnableEvents = False

For Each cell In Target
    If Not Intersect(cell, Range("B7")) Is Nothing And cell <> "" Then
        pwd = Application.InputBox("Password for " & cell & ":", _
                    "Enter Password", Type:=2)
        Select Case cell.Value
            Case "Marc"
                If pwd <> Marc Then Oops = True
            Case "Nina"
                If pwd <> Nina Then Oops = True
            Case "Lars"
                If pwd <> Lars Then Oops = True
            Case "Ibo"
                If pwd <> Ibo Then Oops = True
        End Select
        
        If Oops Then
            MsgBox "Bad password"
            cell = ""
        End If
    End If
Next cell

Application.EnableEvents = True
End Sub

Hope that someone can help me

[LeoTaxi]

With extra sheet with Users and there passwords, to be hide
and dynamic named range with users for the validation list

Option Explicit

Private Sub Worksheet_Activate()
With Sheets("sheet1")
    .Unprotect Password:="test"
    .Range("B7") = ""
    .Range("B8", "F20").Locked = True
    .Protect Password:="test"
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pwd As String, my_users As Range, pwdstored As String, free_range As Range
Set free_range = Sheets("sheet1").Range("B8", "F20")
If Target.Address = "$B$7" And Target <> "" Then
    With Sheets("Passwords").Range("A:A")
        Set my_users = .Find(Target, LookIn:=xlValues, lookat:=xlWhole)
        If Not my_users Is Nothing Then
            pwdstored = .Cells(my_users.Row, 2)
        Else
            MsgBox "Invalid User"
            Exit Sub
        End If
        pwd = Application.InputBox("Password for " & Target & ":", _
                    "Enter Password", Type:=2)
        If pwd = pwdstored Then
            Sheets("sheet1").Unprotect Password:="test"
            free_range.Locked = False
            Sheets("sheet1").Protect Password:="test"
        Else
            MsgBox "Bad password"
            Sheets("sheet1").Unprotect Password:="test"
            free_range.Locked = True
            Sheets("sheet1").Protect Password:="test"
        End If
    End With
End If
End Sub

Kind regards
Leo

[Maschine10]

Hi Leo,

thank you so much for your help!
It works perfectly