-3

I have a workbook where several people will make an entry during the week. Every entry is on its own row. Now i would like to have excel automatic insert the "Windows log-in name" of the user who made the entry, lets say on column K in that speciffic row.

I have found and tried to use the following script.

Function GetName(Optional NameType As String) As String
     'Function purpose:  To return the following names:
     'Defaults to MS Office username if no parameter entered
     '
     'Formula should be entered as =GetName([param])
     '
     'For Name of Type       Enter Text  OR  Enter #
     'MS Office User Name      "Office"        1 (or leave blank)
     'Windows User Name        "Windows"       2
     'Computer Name            "Computer"      3

     'Force application to recalculate when necessary.  If this
     'function is only called from other VBA procedures, this
     'section can be eliminated. (Req'd for cell use)
    Application.Volatile


     'Set value to Office if no parameter entered
    If Len(NameType) = 0 Then NameType = "OFFICE"

     'Identify parameter, assign result to GetName, and return
     'error if invalid
    Select Case UCase(NameType)
    Case Is = "OFFICE", "1"
        GetName = Application.UserName
        Exit Function
    Case Is = "WINDOWS", "2"
        GetName = Environ("UserName")
        Exit Function
    Case Is = "COMPUTER", "3"
        GetName = Environ("ComputerName")
        Exit Function
    Case Else
        GetName = CVErr(xlErrValue)
    End Select

End Function

I would then call GetName(2) from the relevant cell, but when a new user enter a new entry, all the previous user names are set to the new user.

Any help on this problem, are welcome

Thx Taz

UPDATE:

Thx for the answers, they helped me get a bit further in solving my problem. I have now come up with this code, but theres some strange things going on sometimes.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim User As String
    User = Environ("UserName")

    If Not Intersect(Target, Range("a7:a30")) Is Nothing Then
        ActiveSheet.Unprotect
        Application.EnableEvents = False
        ActiveCell.Offset(0, 10).Value = User
        Application.EnableEvents = True
        ActiveSheet.Protect
    End If
End Sub

This is pretty much working like it should, however it is possible to kinda fool the offset, so it will sometimes write the username only 9 offsets away. Is it possible to change the code so i can write to a cell in a fixed column, on that row that is active ?

/Taz

Community
  • 1
  • 1
Tazhix
  • 3
  • 3
  • 1
    This is a user-defined function that will process whenever Excel commands a recalculate - so all previous entries will recalculate too. There are a few ways around it, but I'd capture a `Worksheet_Change` event if it occurs on the relevant row and convert this to a `Sub` routine that writes the value itself into the cell. – Ambie Nov 07 '15 at 13:04
  • 1
    See [This](http://stackoverflow.com/questions/13860894/ms-excel-crashes-when-vba-code-runs/13861640#13861640) This will get you started. – Siddharth Rout Nov 07 '15 at 15:30
  • 1
    why not just save the entry as value? simple way to get rid of unnecessary recalculations. – Munir Nov 07 '15 at 20:53

1 Answers1

0

With the help of this forum, i was able to make excel do what i wanted, i post the code here.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim row, col, user, ColCell As String

user = Environ("UserName")

col = "G" 'Set the Column ?

If Not Intersect(Target, Range("B7:B30")) Is Nothing Then

    ActiveSheet.Unprotect

    Application.EnableEvents = False

    row = Split(Selection.Address, "$")(2) 'Get row number
    ColCell = col & row
    Range(ColCell).Value = user
    'MsgBox "ColCell is : " & ColCell

    Application.EnableEvents = True

    ActiveSheet.Protect

End If

End Sub

But i have one question still, i have alot of sheets in my workbook, do i need to put this code in all the sheets, or is there a way that i can avoid this, and only have the code run from one place ?

Tazhix
  • 3
  • 3