Initial and Date Stamp

[tlc53]

Hi there,

I currently have a drop down list which requires an individuals unique password to change it. Once a name is selected/the correct password is entered, I would like an initial and date stamp to be applied to the cell to the right of the drop down list. This stamp should only change again, if a new name is successfully selected from the drop down box (if the wrong password is entered, the drop down lists default is blank but date stamp shouldn't change).

Can someone please help me amend my code to include this initial and date stamp?

My Drop Down List is located in cell P8 and I'd like the Initial/Date stamp in S8.
Stamp eg. TR 12/02/2019

Thanks very much!

Option Explicit
Const Nick_Brown As String = "Nick1"
Const Tessa_Richards As String = "Tessa1"


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("P8")) Is Nothing And cell <> "" Then
pwd = Application.InputBox("Password for " & cell & ":", _
"Enter Password", Type:=2)
Select Case cell.Value
Case "Nick Brown"
If pwd <> Nick_Brown Then Oops = True
Case "Tessa Richards"
If pwd <> Tessa_Richards Then Oops = True
End Select

If Oops Then
MsgBox "Incorrect Password"
cell = ""
End If
End If
Next cell


Application.EnableEvents = True
End Sub

 

[DanteAmor]

Try:

Option Explicit


'Principal Details
Const Nick_Brown As String = "Nick1"
Const Tessa_Richards As String = "Tessa1"
'Const Tessa_Richards As String = "Tessa1"
'Reviewer Details
Const Christina_Hoover As String = "Chris1"
Const Colleen_Marshall As String = "Colleen1"




Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim pwd As String
    Dim Oops As Boolean
    
    Oops = True
    For Each cell In Target
        If Not Intersect(cell, Range("P8")) Is Nothing And cell <> "" Then
            pwd = Application.InputBox("Password for " & cell & ":", _
            "Enter Password", Type:=2)
            
            Select Case cell.Value
                Case "Nick Brown"
                    If pwd = Nick_Brown Then
                    Oops = False
                    If Range("S8").Value = "" Then
                    Range("S8").Value = "NB " & Date
                    Else
                    If Left(Range("S8").Value, 2) <> "NB" Then
                    Range("S8").Value = "NB " & Date
                    End If
                    End If
                    End If
            
                Case "Tessa Richards"
                    If pwd = Tessa_Richards Then
                    Oops = False
                    If Range("S8").Value = "" Then
                    Range("S8").Value = "TR " & Date
                    Else
                    If Left(Range("S8").Value, 2) <> "TR" Then
                    Range("S8").Value = "TR " & Date
                    End If
                    End If
                    End If
            
            End Select
            
            If Oops Then
                MsgBox "Incorrect Password"
                Application.EnableEvents = False
                cell = ""
                Application.EnableEvents = True
            End If
        End If
        
        If Not Intersect(cell, Range("P7")) Is Nothing And cell <> "" Then
            pwd = Application.InputBox("Password for " & cell & ":", _
                "Enter Password", Type:=2)
            
            Select Case cell.Value
            
            Case "Tessa Richards"
                If pwd = Tessa_Richards Then
                Oops = False
                If Range("S7").Value = "" Then
                Range("S7").Value = "TR " & Date
                Else
                If Left(Range("S7").Value, 2) <> "TR" Then
                Range("S7").Value = "TR " & Date
                End If
                End If
                End If
            
            Case "Christina Hoover"
                If pwd = Christina_Hoover Then
                Oops = False
                If Range("S7").Value = "" Then
                Range("S7").Value = "CH " & Date
                Else
                If Left(Range("S7").Value, 2) <> "NB" Then
                Range("S7").Value = "CH " & Date
                End If
                End If
                End If
            
            Case "Colleen Marshall"
                If pwd = Colleen_Marshall Then
                Oops = False
                If Range("S7").Value = "" Then
                Range("S7").Value = "CM " & Date
                Else
                If Left(Range("S7").Value, 2) <> "NB" Then
                Range("S7").Value = "CM " & Date
                End If
                End If
                End If
            
            End Select
            
            If Oops Then
            MsgBox "Incorrect Password"
            Application.EnableEvents = False
            cell = ""
            Application.EnableEvents = True
            End If
        End If
    Next cell


End Sub

 

[tlc53]

Awesome!!! Thank you!!!

 

[DanteAmor]

You're welcome