This VBA script records in the A column the user who modified the B column.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
Dim xRg As Range, xCell As Range
On Error Resume Next
If (Target.Count = 1) Then
If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _
Target.Offset(0, -1) = Application.UserName
Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B"))
If (Not xRg Is Nothing) Then
For Each xCell In xRg
xCell.Offset(0, -1) = Application.UserName
Next
End If
Application.EnableEvents = True
End If
End Sub
I need a script to: write in the A column the name of pc user who edited in the columns range B:S
So you want the username to be written in column A, on the row any changes are made in column B to Sright?
So something like:
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Count = 1) And Not Application.Intersect(Target, Range("B:S")) Is Nothing Then
Cells(Target.Row, 1) = Application.UserName
End If
End Sub
Related
I'm attempting to have Column K update with last modified date & time of its own row. I got close using the following code, but it modifies everything in the row after it when I only want it to change the Now value in Column K.
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:J")) Is Nothing Then
Target.Offset(0, 1) = Now
End If
End Sub
I know I have to change the Taege.Offset to something else, but what would that be to not break code/debug. I considered Target.Column, but I'm unsure of how to write the syntax.
Secondly, I'd like it to ignore row 1 & 2. I thought about changing Range("A:J") to Range("A3:J") but that also break/debugs.
All help is welcomed & appreciated.
You can do it like this:
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Target, Me.Range("A:J"))
If Not rng Is Nothing Then
Application.screenupading = False
For Each c In rng.Cells
c.EntireRow.Columns("K").Value = Now
Next c
End If
End Sub
Maybe try something like this
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Not Intersect(Target, Range("A:J")) Is Nothing Then
For Each rng In Target.Rows
If rng.Row > 2 Then
Cells(rng.Row, 11).Value = Now
End If
Next rng
End If
End Sub
Perhaps a better solution would be this
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Column < 11 Then
Application.EnableEvents = False
For Each rng In Target.Rows
If rng.Row > 2 Then: Cells(rng.Row, 11).Value = Now
Next rng
Application.EnableEvents = True
End If
End Sub
A solution with no looping needed
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 11 Then ' 11 = K,
Intersect(Range(Cells(3, 11), Cells(WorksheetFunction.Min( _
Target.Rows.CountLarge + Target.Row - 1, Rows.CountLarge), 11)), _
Target.EntireRow).Value = Now
End If
End Sub
Can someone please help me with this code. It will insert the current date in H if I do any changes to I.
My problem is that this will not work if for example I fill in I1 with something, and then I drag down for copying in many cells at once. If for example I copy value from I1 once at a time in each cell( I2,I3 ETC) it will work.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
Dim xRg As Range, xCell As Range
On Error Resume Next
If (Target.Count = 1) Then
If (Not Application.Intersect(Target, Me.Range("I:I")) Is Nothing) Then _
Target.Offset(0, -1) = Date
Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("I:I10"))
If (Not xRg Is Nothing) Then
For Each xCell In xRg
xCell.Offset(0, -1) = Date
Next
End If
Application.EnableEvents = True
End If
End Sub
Thank you !
Avoid the unnecessary use of On Error Resume Next. Handle the Error gracefully. I recommend reading THIS once when using Worksheet_Change
Also you have If (Target.Count = 1) Then because of which your code doesn't execute. When you drag, the count increases.
Is this what you are trying?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Dim aCell As Range
Application.EnableEvents = False
If Not Intersect(Target, Range("I:I")) Is Nothing Then
For Each aCell In Target
'~~> Additional blank check for I. So that the date
'~~> is not inserted if the value is deleted. Remove this
'~~> if you want the date to be inserted even when the value is deleted
If Len(Trim(aCell.Value)) <> 0 Then
Range("H" & aCell.Row).Value = Date
Else
'Remove Date?
End If
Next aCell
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
In action:
I have problem in my code, i need to change in another column - row
I tried to built macro but it's dosn't work with that.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Target, Range("A6:U1000"))
If xRg Is "YES" Then Exit Sub
Range("G" & Target.Row).Value = "CHECK"
End Sub
When in column N6:N1000 is "YES" in Column G change value to "Check" and all row A6 for example to U1000 is in color red
I can't quite understand what you're trying to achieve here, but hopefully the below will be doing roughly what you need. Try it and let me know if it doesn't behave the way you hope.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim xRg As Range, cl as Range
Set xRg = Intersect(Target, Range("A6:U1000"))
If Not xRg Is Nothing Then
For Each cl In xRg.Cells
If cl.Value = "YES" Then Range("G" & cl.Row).Value = "CHECK"
Next
End If
Application.EnableEvents = True
End Sub
I am trying to run this worksheet change event for two different columns(A) and (I)...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("A:A")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
r.Offset(0, 1).Value = Date
Next r
Application.EnableEvents = True
End Sub
This event is something i found on this forum. Its purpose is to make it so whenever data is ever entered into column "a" it auto inputs the date into the cell directly right of it. I want this to happen twice on the worksheet. I can't figure out how to change/add to it. I am trying to get it to run the logic for column A and I on my spreadsheet.
Just expand the range you set to the A variable.
Set A = Range("A:A, I:I")
Rewritten as,
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(range("A:A, I:I"), target) is nothing then
'add error control
on error goto safe_exit
'don't do anything until you know something has to be done
dim r as range
Application.EnableEvents = False
For Each r In intersect(range("A:A, I:I"), target)
r.Offset(0, 1).Value = Date 'do you want Date or Now?
Next r
end if
safe_exit:
Application.EnableEvents = True
End Sub
edited after OP's comment
expanding on #Jeeped solution, you can avoid looping:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A:A, I:I"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
So I'm adding a picture so you can see exactly what I need it to do -Excel sheet picture
So I have this script:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, G, L, N As Range, Inte As Range, r As Range
Set A = Range("F:F,K:K,M:M")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
If r.Offset(0, 1).Value = "" Then
r.Offset(0, 1).Value = Date
End If
Next r
Application.EnableEvents = True
End Sub
We will talk about only what we see in the picture: so now when I write anything in column F it gives the date in column G, I want that it will give the date only if I write "Ja" (Yes in German) or "Yes"
Simple is that. I tried to find any "if" commands for it but none of mine worked.
Hope you can help me with that
Thanks!
Daniel
Here is a better practice to achieve that also you need to set Application.EnableEvents back to True when you are existing the method for the next time the event will be raised, also its not bad to make some "house keeping" and use error catch if something goes wrong:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ende
Application.EnableEvents = False
Set A = Range("F:F,K:K,M:M")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then
Application.EnableEvents = True
Exit Sub
End If
For Each cel In Target
r = cel.Row
c = cel.Column
If Trim(LCase(Cells(r, c))) = "yes" Or Trim(LCase(Cells(r, c))) = "ja" Then
Cells(r, c + 1) = Format(Date, "dd.MM.yyyy")
Else
' do something else
End If
Next
ende:
Application.EnableEvents = True
End Sub
What about this?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim rng As Range
Set rng = Range("F:F,K:K,M:M")
On Error GoTo SkipError
Application.EnableEvents = False
If Not Intersect(Target, rng) Is Nothing Then
For Each cell In Target
If LCase(VBA.Trim(cell.Value)) = "yes" Then
cell.Offset(0, 1) = Date
End If
Next cell
End If
SkipError:
Application.EnableEvents = True
End Sub