Signature Authentication

[Josh]

I am trying to make my excel sheet automatically give off the date and time
when some data is inputted into the cells next to it. I managed to do this
with this code but wanted to add the security that the person signing off is
actually authentic. I tried to insert your code into my previous code and it
kept giving me "Method "Value" of Object "Range" failed". Do you have any
suggestions?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo EndItAll
Application.EnableEvents = False
If Target.Cells.Column = 5 Or Target.Cells.Column = 8 Or
Target.Cells.Column = 11 Then
ActiveSheet.Unprotect Password:="justme"
For Each cell In Target
If cell.Value <> "" Then
With cell.Offset(0, 1)
.Value = Now
.Locked = True
End With
End If
Next
End If
EndItAll:
Application.EnableEvents = True
'ActiveSheet.Protect Password:="justme"
Range("e2").Value = Environ("UserName")
End Sub

 

[ryguy7272]

This gets the name on the System:
'******************** Code Start **************************

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
'******************** Code End **************************

Is that helpful?


Regards,
Ryan---

 

[Norman Jones]

Hi Josh,

Try the following minor adaptation of
your code:

'===========>>
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
Const PWORD As String = "justme"

On Error GoTo EndItAll
Application.EnableEvents = False

With Me
If Target.Cells.Column = 5 _
Or Target.Cells.Column = 8 _
Or Target.Cells.Column = 11 Then
.Unprotect Password:=PWORD
For Each rCell In Target.Cells
If rCell.Value <> "" Then
With rCell.Offset(0, 1)
.Value = Now
.Locked = True
End With
End If
Next
End If
EndItAll:
.Range("E2").Value = Environ("UserName")
.Protect Password:=PWORD
Application.EnableEvents = True
End With
End Sub
'<<===========