There's a lot I like about this script I use to auto-insert the date into next cell over from where I input a value, but I would like if it didn't change a date that already existed.
When I input the initials of whoever finished a job into a cell in range T3:T5003, the date is automatically inserted in the adjacent cell in range U3:U5003. The problem is that I might have to change or modify the entries in T3:T5003 at a later date, but I don't want the original date to change. So I just want this auto-inserting to work only when there is nothing in the adjacent cell.
Here's the code I am using:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("T3:T5003"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).Activate
Else
With .Offset(0, 1)
.Value = Date
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
I've tried other scripts that didn't write over an existing date, but they had other problems, and they were difficult for me to understand how they work, so I'm hoping that we can just modify the one I'm using. But I will take anything that works and I really appreciate your help.
I think you just need to an IF checking if the cell to the right is empty or not:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A1:A100"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).Activate
Else
If .Offset(0, 1).Value2 = "" Then
With .Offset(0, 1)
.Value = Date
End With
End If
End If
Application.EnableEvents = True
End If
End With
End Sub
This should do
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("T3:T5003"), .Cells) Is Nothing Then
If IsEmpty(.Offset(0, 1)) Then .Offset(0, 1).Value = Date
End If
End With
End Sub
Related
I would like to add an additional '-' sign to the value in the Hours column if the status is changed from 'Pending' to 'Completed'.
I tried the "Worksheet_Change" event but I do not see any changes in my worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C5:C14")) Is Nothing Then Exit Sub
Application.EnableEvents = False
With Intersect(Range("C5:C14"), Target)
.Offset(, -1).Value = -.Offset(, -1).Value
.ClearContents
End With
Application.EnableEvents = True
End Sub
I would like to create a sheet where I have rows that get a timestamp in the column next to it, if the content in the cell changes.
What do I do wrong in the following macro? The first macro works on its own, but not if I add several macros.
Sub Update01()
Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
End Sub
Sub Update02()
If Target.Column <> 3 Then Exit Sub
If Target.Cells.Count > 3 Then Exit Sub
With Target.Offset(0, 3)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
End
Sub Main()
Call Update01
Call Update02
End Sub
You probably meant to do something like the following
Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error Goto ENABLE_EVENTS
Application.EnableEvents = False
If Target.Column = 1 Then
With Target.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
ElseIf Target.Column = 3
With Target.Offset(0, 3)
.Value = Now
.NumberFormat = "MM/DD/YYYY hh:mm AM/PM"
End With
End If
ENABLE_EVENTS:
Application.EnableEvents = True
End Sub
Note that you need to Application.EnableEvents = False before writing a value to a cell otherwise this would trigger the Worksheet_Change over and over again.
Also note that Worksheet_Change is an event. That means it runs automatically whenever a cell value in the worksheet gets changed. You cannot run this procedure manually and you cannot Call it.
I have a code already but I want to know if this code can be altered or if there is a code that can check to see if a cell in the column E is empty and clear contents in a cell in column A if the someone exits the row
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If Target.Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
End If
End Sub
Edited as per DirkReichel suggestion
Add this formula in A1:
=IF(E1="","",IF(LEN(A1),A1,TODAY()))
Now drag it down in your column "A" as far as you need. It will add today's date in column "A" if there is a value in column "E". Otherwise column "A" will remain empty
You are trying to get information of the "last" selection upon a change.... but there isn't a build-in solution. With a global variable, you still can do like this:
Dim oldTarget As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If oldTarget Is Nothing Then GoTo e
If oldTarget.Rows.Count > 1 Then
Dim x As Range
For Each x In oldTarget.Rows
If x.Cells(1, 5).Value = "" Then x.Cells(1, 1).Value = ""
Next
Else
If oldTarget.Cells(1, 5).Value = "" Then oldTarget.Cells(1, 1).Value = ""
End If
e: Set oldTarget = Target.EntireRow
End Sub
As you see: Dim oldTarget As Range is outside of the sub. This way the set value/object stays until VBA get's stopped (closing the workbook / directly reset vba)
The first bit of your code checks for changes on column E to clear the column A.
So we just need to do the same thing again, but checking if column E is empty when changing column A.
This way, if you change the value on Column A and, at the same row, Column E is empty, it clears what you entered.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If Target.Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
Elseif Target.Column = 1 Then
If Cells(Target.Row, 5).Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
End If
End Sub
Edit: So, after your comment, here is how you should use your code
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
If Target.Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
Else
'Insert here whatever code you got on the single click event (Except the sub and end sub)
End If
Elseif Target.Column = 1 Then
If Cells(Target.Row, 5).Value = vbEmpty Then
Cells(Target.Row, 1).ClearContents
End If
End If
End Sub
I am using this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = True
On Error GoTo Errormask
With Target
If .Column = 30 And .Row > 16 And .Value = "Remove" Then
.EntireRow.Delete
Target.Offset(, 2).Select
End If
End With
Errormask:
Application.DisplayAlerts = False
Exit Sub
End Sub
If a user clicks on the cell in column 30 which contains "remove", it should delete the row and then select the cell 1 across.
This is not working. Please can someone show me where i am going wrong?
In your with, do the offset on the line below before deleting the entire row.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If Target.CurrentRegion.Count = 1 And Target.Cells.Count = 1 Then
If .Column = 30 And .Row > 16 And .Value Like "Remove" Then
.Offset(1, 2).Select
.EntireRow.Delete
End If
End If
End With
Application.DisplayAlerts = False
End Sub
Are you sure you have this in the code of your sheet and not in a module?
EDIT
I have added a new If to check the select cell isn't merged first, and only a single cell is selected.
Try the code below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = True
On Error GoTo Errormask '<-- don't see the need for this line
With Target
If .Column = 30 And .Row > 16 And .Value Like "Remove" Then
.EntireRow.Delete
.Offset(, 2).Select
End If
End With
Errormask: '<-- don't see the need for this line
Application.DisplayAlerts = False
Exit Sub '<-- don't see the need for this line, anyway at the end of the Sub
End Sub
The code below works fine when I manually update column I. What I need is to know if there is a way to still have this code work when I have column I updated by a formula.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("I3:I30"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, -1).ClearContents
Else
With .Offset(0, -1)
.NumberFormat = "m/d/yy h:mm"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
Worksheet_Change does not fire in responce to a formula update.
See Excel help for Worksheet_Change
Occurs when cells on the worksheet are changed by the user or by an external link.
You could maybe achieve what you want with the Worksheet_Calculate event.
Assuming you want to put a time stamp next to the cells when those vall values change, try this (in addition to your Change event).
Note the use of the Static variable to track previous values, since Calculate event does nopt provide a Target parameter like Change does. This method may not be robust enough since Static's get reset if you break vba execution (eg on an unhandled error). If you want it more robust, consider saving previous values on another (hidden) sheet.
Private Sub Worksheet_Calculate()
Dim rng As Range, cl As Range
Static OldData As Variant
Application.EnableEvents = False
Set rng = Me.Range("I3:I30")
If IsEmpty(OldData) Then
OldData = rng.Value
End If
For Each cl In rng.Cells
If Len(cl) = 0 Then
cl.Offset(0, -1).ClearContents
Else
If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then
With cl.Offset(0, -1)
.NumberFormat = "m/d/yy h:mm:ss"
.Value = Now
End With
End If
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub
Update
Tested routine on sample sheet, all works as expected
Sample file contains the same code repeated on 25 sheets, and range to time stamp is 10000 rows long.
To avoid repeating the code, use the Workbook_ events. To minimise run time use variant arrays for the loop.
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim rng As Range
Dim NewData As Variant
Dim i As Long
Static OldData As Variant
Application.EnableEvents = False
Set rng = Sh.Range("B2:C10000") ' <-- notice range includes date column
NewData = rng
If IsEmpty(OldData) Then
OldData = rng.Value
End If
For i = LBound(NewData, 1) To UBound(NewData, 1)
If Len(NewData(i, 1)) = 0 And Len(NewData(i, 2)) > 0 Then
rng.Cells(i, 2).ClearContents
Else
If NewData(i, 1) <> OldData(i, 1) Then
With rng.Cells(i, 2)
.NumberFormat = "m/d/yy -- h:mm:ss"
.Value = Now
End With
End If
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Activate date population on cell change
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Sh.Range("B2:B10000"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
'Populate date and time in column c
With .Offset(0, 1)
.NumberFormat = "mm/dd/yyyy -- hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub