username and stamp

[MMM_84]

Hi All,

I have a code for username and time stamp as follows, but it doesn't work, as I have another code on the same spreadsheet, which is also "worksheet change..." would you please help?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    If Not Intersect(Target, Me.Range("Am1:Am2000")) Is Nothing Then
        For Each cell In Intersect(Target, Me.Range("Am1:Am2000"))
            If cell.Value <> "" Then
                Me.Cells(cell.Row, "As").Value = Now()
                Me.Cells(cell.Row, "At").Value = Application.UserName
                              
            Else
                Me.Cells(cell.Row, "As").ClearContents
                Me.Cells(cell.Row, "At").ClearContents
                          
            End If
        Next cell
    End If
End Sub

 

[RoryA]

What is the other code that you need this integrated into?

 

[MMM_84]

What is the other code that you need this integrated into?

another one is as follow

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("T:T,W;W")) Is Nothing Or Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
Select Case Target.Column
Case Is = 20
Cells(Target.Row, Target.Column + 1).Value = Evaluate("=vlookup(" & Target.Address & ", Sheet2!A:C,2)")
Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*10")
Case Is = 23
Cells(Target.Row, Target.Column + 1).Value = Evaluate("=" & Target.Address & "*3")
Case Else
MsgBox "Error!"
End Select
Application.EnableEvents = True
End Sub

 

[RoryA]

You could do something like this, though I would probably make the second code you posted into a loop like the first one:

Private Sub Worksheet_Change(ByVal Target As Range)
   On Error GoTo err_handle
   Dim cell As Range
   If Not Intersect(Target, Me.Range("Am1:Am2000")) Is Nothing Then
   
      Application.EnableEvents = False ' turning this off prevents changes made by this code from triggering the change event again
      
      For Each cell In Intersect(Target, Me.Range("Am1:Am2000"))
      
         If cell.Value <> "" Then
            Me.Cells(cell.Row, "As").Value = Now()
            Me.Cells(cell.Row, "At").Value = Application.UserName
         Else
            Me.Cells(cell.Row, "As").ClearContents
            Me.Cells(cell.Row, "At").ClearContents
         End If
         
      Next cell
      
   End If
   
   If Not Intersect(Target, Range("T:T,W;W")) Is Nothing And Target.Row > 1 Then
      
      Application.EnableEvents = False
      Select Case Target.Column
         Case Is = 20
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=vlookup(" & Target.Address & ", Sheet2!A:C,2)")
            Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*10")
         Case Is = 23
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=" & Target.Address & "*3")
         Case Else
            MsgBox "Error!"
      End Select
   End If
   
clean_up:
   Application.EnableEvents = True
   Exit Sub
   
err_handle:
   MsgBox Err.Description
   Resume clean_up
End Sub