Username Date & Time

[Spraggs]

Evening,
I've got a worksheet where I want to enter the username, date & time in columns CA, CB & CC whenever a cell is altered in the corresponding column of range B6:BK52.
i.e. If cell F12 is altered then the username, date & time to be entered in CA12, CB12 & CC12. How can this be done?

Thanks Jase

 

[pedie]

Spaggs, try this in Worksheet module.

[/FONT]
[FONT=Courier New]Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B6:BK52")) Is Nothing Then
 Cells(Target.Row, "CA").Value = Application.UserName
 Cells(Target.Row, "CB").Value = Date
 Cells(Target.Row, "CC").Value = Time
End If
End Sub

 

[Ruddles]

Are the cells in the range B6:BK52 altered by someone entering values into them or because they contain formulae whose values might change as a result of the worksheet being recalculated?

 

[Spraggs]

Pedie,
Brilliant, thank you.

Thanks Ruddles. Seeing that Pedie's answer works I think answers your question. Thanks all the same.

 

[Ruddles]

Yes, she was seconds ahead of me on the Enter key!

 

[Avatar]

Are you using this on a corporate network and/or for auditing purposes?

The reason i ask is Application.username is manually set by the user and could be Mickey Mouse if the user wanted it to be.

You could use something like:

Environ("username")

- But Environ isn't always reliable. It varies from PC to PC.

If you are working on an Active Directory network, another way would be to do something like:
Module:

Option Explicit

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

Public Function fOSUserName() As String
 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 = ""
 fOSUserName = UCase(fOSUserName)
End Function

Worksheet would be as pedie suggested but with the function instead:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("B6:BK52")) Is Nothing Then
  Cells(Target.Row, "CA").Value = fOSUserName
  Cells(Target.Row, "CB").Value = Date
  Cells(Target.Row, "CC").Value = Time
 End If
End Sub