Code to automatically insert usernames into cells

[CAMARD2]

Hey all,

I'm in need of a code that will automatically insert the username of the person who makes a change in a specific set of cells.


So for context I have cells C3, C29, C38, C42, C52 & A61 that start off empty by default. What I want is when somebody adds text to any of these cells, their username will automatically be inserted in cells I3, I29, I38, I42, I52 & I61 respectively (same rows)


I tried putting a code in place but I'm new to this VBA stuff and could not get something working.

Any help would be appreciated. Thanks!

 

[Computerman]

CAMARD2,
I am assumingthat you have the username in a variable, which I’ll call for this example ‘UserName’.The code to place the users name in the cells you referenced would be (replaceSheet1 with the sheet number your cells are on, if different)

[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Sheet1.Range(“I3”).value = UserName[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Sheet1.range(“I29”).value= UserName[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]

And so forth for the rest of the cells you need the username to appear in.
Computerman

 

[Mentor82]

Hi,
Try the below code. Insert it in worksheet module. By the way, the range you mentioned as last A61 is ok or should it be C61 instead?. If it's ok I'd need to fix below code a little bot because I've considered it as a mistake and taken in the code C61 instead. Let me know.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$3" or _
Target.Address = "$C$29" or _
Target.Address = "$C$38" or _
Target.Address = "$C$42" or _
Target.Address = "$C$52" or _
Target.Address = "$C$61" then
        Target.offset(0,8)=application.UserName
    End If
End Sub

 

[CAMARD2]

Thanks for the replies !

A1 was not an error.

So, I'm looking to have the username inserted in cells I3, I29, I38, I42, I52 & I61 whenever cells C3, C29, C38, C42, C52 & A61 are modified. (so when C3 is modified, the username will appear in cell I3, and when A61 is modified the username appears in cell I61, etc...)

Also what exactly do you mean when you say to insert it in worksheet module? I'm new to this stuff. Do you just mean that I insert this code in a module rather than on the general window that pops up by default?

Thanks!

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("C3,C29,C38,C42,C52,A61")) Is Nothing Then
     [COLOR=#0000ff] Range("I" & Target.Row).Value = Application.UserName[/COLOR]
      [COLOR=#ff0000]Range("I" & Target.Row).Value = Environ("Username")[/COLOR]
   End If
End Sub

Right click the tab of the sheet you want this to work, select view code & paste the code into the window that opens up.
The line in blue will insert the Excel username, whereas the line in red will insert the Windows login name.
delete which ever you don't want

 

[CAMARD2]

That works great! Thank you!

 

[Fluff]

You're welcome & thanks for the feedback

 

[CAMARD2]

Alright so upon further testing things I have another small request if possible.
When the contents are erased from column C (or A61) I'd like for the username to also be removed from the corresponding cell in column I, if possible.

Also, not sure if this one is possible, but right now the username is also inserted when just double clicking one of the cells in column C, without actually modifying anything in the cell. Is there a way to prevent that from happening?

 

[DanteAmor]

With the permission of Fluff.
With the following the double click is solved and when you delete the data.

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("C3,C29,C38,C42,C52,A61")) Is Nothing Then
        If Target.Value = "" Then
            Cells(Target.Row, "I").Value = ""
        Else
            Range("I" & Target.Row).Value = Application.UserName
            'Range("I" & Target.Row).Value = Environ("Username")
        End If
   End If
End Sub

 

[Fluff]

This will remove the username if the cell is blank

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("C3,C29,C38,C42,C52,A61")) Is Nothing Then
      If Target.Value = "" Then
         Range("I" & Target.Row).ClearContents
      Else
         Range("I" & Target.Row).Value = Application.UserName
         Range("I" & Target.Row).Value = Environ("Username")
      End If
   End If
End Sub

Re the double click, the easiest way would be to disable doubleclick on those cells.
Is that ok?