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
Related
I need to copy the contents of a cell in a particular column to another corresponding column on change so the old value is moved. Only wants to work for a particular column.
Private sub Worksheet_Change(ByVal Target As Range)
if Target.Range("L:L") then
'set I cell value = to original L cell value
ActiveCell.Offset(0,-3).Value = ActiveCell.Value
End If
End Sub
This code should do what you want. Please take note of the comments which explain some limitations I have imposed on the action of this procedure. The rule to follow is to not give it more power than it needs to do the job you want it to do.
Private Sub Worksheet_Change(ByVal Target As Range)
' 027
Dim Rng As Range
' don't react if the changed cell is in row 1 or
' if it is more than 1 row below the end of column L
Set Rng = Range(Cells(2, "L"), Cells(Rows.Count, "L").End(xlUp).Offset(1))
If Not Application.Intersect(Target, Rng) Is Nothing Then
With Target
' skip if more than 1 cell was changed
' meaning, exclude paste actions
If .Cells.CountLarge = 1 Then
.Offset(0, -3).Value = .Value
End If
End With
End If
End Sub
This will save the previous value in column I:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant
If Target.Count > 1 Then Exit Sub
If Intersect(Range("L:L"), Target) Is Nothing Then Exit Sub
With Application
v = Target.Value
.EnableEvents = False
.Undo
Target.Offset(0, -3).Value = Target.Value
Target.Value = v
.EnableEvents = True
End With
End Sub
EDIT#1:
To update L without triggering the event, use something like:
Sub ScriptThatUpdatesColumn_L()
Application.EnableEvents = False
Range("L5").Value = "just me"
Application.EnableEvents = True
End Sub
I have a column named "time" in my excel sheet. I want to write a code such that whenever user performs an entry in time column, if it is a whole number, it should accept, but if it is not a pop up should appear saying "only numbers allowed". Also, the validation should be dynamic i.e. should automatically validate next row if users enters a new entry
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = Range("Meeting Time").Column Then
If Not (IsNumeric(Target.Value)) Then
MsgBox "only numbers allowed"
Target.Value = ""
Target.Select
End If
End If
End Sub
You could try:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'1. Check if the column that affected is B (change to the column you want)
'2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
'Check if target is numeric
If Not IsNumeric(Target.Value) Then
Call Clear(Target)
End If
'Check if target.offset(1,0) is numeric
If Not IsNumeric(Target.Offset(1, 0).Value) Then
Call Clear(Target.Offset(1, 0))
End If
End If
End Sub
Sub Clear(ByVal rng As Range)
'Disable events in order to prevent code to re trigger when clear cell
Application.EnableEvents = False
rng.Value = ""
'Enable events
Application.EnableEvents = True
End Sub
EDITED VERSION:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'1. Check if the column that affected is B (change to the column you want)
'2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
'Check if target is numeric
If Not IsNumeric(Target.Value) Then
Call Clear(Target)
ElseIf Target.Value > 160 Or (Target.Value = Int(Target.Value) = False) Then
Call Clear(Target)
End If
'Check if target.offset(1,0) is numeric
If Not IsNumeric(Target.Offset(1, 0).Value) Then
Call Clear(Target.Offset(1, 0))
ElseIf Target.Offset(1, 0).Value > 160 Or (Target.Offset(1, 0).Value = Int(Target.Offset(1, 0).Value) = False) Then
Call Clear(Target)
End If
End If
End Sub
Sub Clear(ByVal rng As Range)
'Disable events in order to prevent code to re trigger when clear cell
Application.EnableEvents = False
rng.Value = ""
'Enable events
Application.EnableEvents = True
End Sub
first you can create a range name for column you want your "time" and you can use the sample codes below.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = Range("time").Column Then
If Not (IsNumeric(Target.Value)) Then
MsgBox "only numbers allowed"
Target.Value = ""
Target.Select
End If
End If
End Sub
I have an excel worksheet that I want to assign to it more than one Worksheet Event.
To be more specific, I want whenever a cell in column B is changed then one cell to the left (column A) gets the row number.
Also I want whenever a cell in column J is changed then one cell to the right (column K) gets today's date.
It worked for me for both of them individually but I think I may be doing something wrong using them together.
Any help will be much appreciated!
Private Sub AG1(ByVal a_Target As Range)
If Not Intersect(a_Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(a_Target.Row, a_Target.Column - 1) = a_Target.Row
Application.EnableEvents = True
End If
End Sub
Private Sub AG2(ByVal b_Target As Range)
If Not Intersect(b_Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(b_Target.Row, b_Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
edit - works now (I also added that column can be referred as letter):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "B" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
ElseIf Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "J" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
Copy the code in the Worksheet_Change event and that should fix your issue. This will trigger every time you enter a value for any cell and will only meet the condition if they intersect the range in the if statement.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
End If
If Not Intersect(Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
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
I have two tables. Both tables are the same size, located in columns I:X and AB:AQ (offset by 19 columns start-to-start).
I want when I enter a number in a cell within the left table, to go 19 columns to the right after pressing enter. Then, once entering text into the active cell in the right table, return 19 cells to the left table.
I found this question/answer, but I wasn't able to apply it.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Target.Cells.CountLarge > 1 Then
If Not Intersect(Target, Columns(9)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(10)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(11)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(12)) Is Nothing Then
Target.Offset(, 19).Select
'etc...
ElseIf Not Intersect(Target, Columns(42)) Is Nothing Then
Target.Offset(, -19).Select
ElseIf Not Intersect(Target, Columns(43)) Is Nothing Then
Target.Offset(, -19).Select
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
As an alternative, if it can recognize that the cell entered is within columns I:X and just offset 19 columns after pressing enter (and then the reverse), this would be fine.
A second alternative, if it is easier, changing the function of the Page Up and Page Down keys, I would not need to check which column I am in.
Lastly, this should only work on a particular sheet Tracking.
Something like this should work for you. Make sure the code is in the 'Tracking' worksheet code module:
And here is the code you would use:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChange1 As Range
Dim rngChange2 As Range
Set rngChange1 = Range("I:X")
Set rngChange2 = Range("AB:AQ")
Application.EnableEvents = False
If Not Intersect(rngChange1, Target) Is Nothing Then
Target.Offset(, 19).Value = Target.Value
End If
If Not Intersect(rngChange2, Target) Is Nothing Then
Target.Offset(, -19).Value = Target.Value
End If
Application.EnableEvents = True
End Sub