How is the ID entered????????????????????????

Worksheets("Log").Range("A1").End(xlDown).Offset(1,0).Value =
Environ("Username")

See if this gets you what you need: paste the following new function into a VB
module:

Option Explicit
'api call for obtaining the username
Private Declare Function GetUserName& Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long)

Public Function WindowsUserName() As String
Dim szBuffer As String * 100
Dim lBufferLen As Long
lBufferLen = 100
If CBool(GetUserName(szBuffer, lBufferLen)) Then
WindowsUserName = Left$(szBuffer, lBufferLen - 1)
Else
WindowsUserName = CStr(Empty)
End If
End Function


The above new function returns the username by entering the new function into a
cell:
say cell  B2=WindowsUserName( )
I found this cool one at vbaexpress.com

Here is a modify version of some code I use to check for a qualified
user.

Sub ConfirmUser()
Dim bolUser As Boolean

bolUser = CheckUser(Environ("USERNAME"))

If bolUser = True Then
If Application.UserName <> "" Then
Range("B1") = Application.UserName
Else
Range("B1") = Environ("USERNAME")
End If
End If

End Sub

Function CheckUser(strUser As String) As Boolean
Dim arrTeam(0 To 8) As String
Dim intCount As Integer

arrTeam(0) = "user1"
arrTeam(1) = "user2"
arrTeam(2) = "user3"
arrTeam(3) = "user4"
arrTeam(4) = "user5"
arrTeam(5) = "user6"
arrTeam(6) = "user7"
arrTeam(7) = "user8"
arrTeam(8) = "user9"


On Error GoTo NoUser:
For intCount = 0 To UBound(arrTeam)
If strUser = arrTeam(intCount) Then
CheckUser = True
Exit For
End If
Next intCount
Exit Function
NoUser:
CheckUser = False
End Function