I have this sub on one of my page, I want that when the user changes one of the cells in B2:B10, the date appears in the column A on the same line :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B2:B10")) Is Nothing Then
Target.Offset(0, -1).Value = Date
End If
End Sub
It works well, but if I select the range A2:B10 and I press Delete I have a 1004 Run Time Error. Do you know why and how I could avoid that ?
Thanks !
When selecting a range from A2 to B10, the intersect in your if is true, but when using Target.Offset(0, -1) you are trying to address a range that is to the left of column A. Because column A is the first one, this obviously leads to an error.
So try to check if the Target.Column is bigger than 1:
If Not Application.Intersect(Target, Range("B2:B10")) Is Nothing Then
If Target.Column > 1 Then
Application.EnableEvents = False 'Prevents the Event from firing again when changing a value.
Target.Offset(0, -1).Value = Date
Application.EnableEvents = True
End If
End If
Also, without disabling the Events, changing a value inside the Change Event will trigger it again leading to a loop.
Related
its me....again. I am currently trying to have a Macro trigger whenever a specific cell increases on a specific sheet.
After many attempts I have been able to get the Macro to trigger when the cell is changed (increasing or decreasing) but I cannot figure out a way to have this Macro trigger only when the specified cell increases in value.
I have tried to use simple Worksheet_Change with an If Then statement that calls the Macro when the cell value is changed. Again I can't get this to trigger only when the cell increases. Not sure it is possible or if I am even thinking about this is in the right way.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address "Range" Then
Call MyMacro
End If
End Sub
Thank you for any help in advance. This would be really neat and save alot of manual clicking around.
Here is the functioning Macro that I want to trigger when certain text is entered into a range.
Sub Auto_Print_Yellow_Caution()
Application.ScreenUpdating = False
Sheets("Saver").Shapes("Group 6").Copy
Sheets("Main").Select
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
I already have my Workbook set up to track these words/phrases and return either a TRUE or FALSE value. If TRUE the associated Order Number is Printed into a Cell and a COUNTIFS formula is used to keep track of how many orders meet the TRUE condition. That number is then used to keep track of how many total of those orders there are. That works using the following
=IF(ISNUMBER(SEARCH("Completed",Main!G7)),TRUE)
-looks for specific word and returns TRUE
=IF(T3=TRUE,Main!A7,"")
-Returns order number
=IF(COUNTIF($U3:$U$200,"?*")<ROW(U3)-2,"",INDEX(U:U,SMALL(IF(U$2:U$200<>"",ROW(U$2:U$200)),ROWS(U$2:U3))))
-Sorts order numbers into list
=COUNTIF(T2:T135,TRUE)
-Counts number of orders
Hopefully this adds context to what I am trying to accomplish.
This will hopefully get you on the right track. As per your question it assumes this is required for a single cell only (and in this example code, that cell is B2). The trick is to store the new value, 'undo' the change, grab the old value, reverse the 'undo' by replacing the new value. Then you can test if the values are numbers and, if so, test if the new number is greater than the old number.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newValue As Variant, oldValue As Variant
If Target Is Nothing Then Exit Sub
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 2 Or Target.Row <> 2 Then Exit Sub ' example is using cell B2
Application.EnableEvents = False
newValue = Target.Value2
Application.Undo
oldValue = Target.Value2
Target.Value2 = newValue
Application.EnableEvents = True
If IsNumeric(oldValue) And IsNumeric(newValue) Then
If CDbl(newValue) > CDbl(oldValue) Then
Call MyMacro
End If
End If
End Sub
Here is some logic I can think of, you need to have a helper cell to store previous data and compare if it increased. In this sample my helper cell is B1 and the cell I want to track is A1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KCells As Range
Set KCells = Sheet10.Range("A1")' The variable KeyCells contains the cells that will
If Not Application.Intersect(KCells, Range(Target.Address)) Is Nothing Then 'cause an alert when they are changed.
If Sheet10.Range("B1").Value < Sheet10.Range("A1").Value Then
MsgBox "Replace this to call macro"
Sheet10.Range("B1").Value = Sheet10.Range("A1").Value 'this is to save the current data incase you change it later.
End If
End If
End Sub
I got a cell which has the formula: =SE(G15<>"";0;"") , it means depending the reference cell isn't blank, it must returns me a 0 in the that cell.
The thing is, sometimes I will have to manually change this cell to another numeric value, erasing the old formula I put, and then in the future this cell will never returns me the 0 again in case I don't put the same formula again.
I want to make a vba code which helps me in that. Every time I delete the cell with the value I put manually, it brings back the formula with the 0, and this in the range F16:Q16.
What I was trying to write is something like:
Sub Worksheet_Change(ByVal Target As Range)
and define the target.range for each cell, but I don't know how to progress anymore.
Please, can someone help in this?
Using the worksheet change event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Target, Me.Range("F16:Q16")) 'range to be checked
If Not rng Is Nothing Then
On Error GoTo haveError
Application.EnableEvents = False 'stop updates from re-triggering this handler
For Each c In rng.Cells
If Not c.HasFormula And Len(c.Value) = 0 Then
c.Formula = "=IF(G15<>"""",0,"""")" 'use US-style from VBA
' or use FormulaLocal
End If
Next c
End If
haveError:
Application.EnableEvents = True 'make sure events are re-enabled
End Sub
From the picture below, all of the data being displayed is populated at run time. Nothing in range E is input at run time, however, I want to write a piece of code in the module that will disable/clear contents of the cells highlighted in yellow. I would only know the row number at run time though. For example, I would know that row 4 will need to have cell E4 disabled for any offline data entry. I have a piece of code that disables the whole range but I only want selective cells to not accept text. I want all cells under E, except E4, E7, E10, E17 and E20, to be able to accept input. Thanks in advance for your help!
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("E1:E10"), Target) Is Nothing Then
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
* Adding Additional screen grabs to help w/ the run time error *
When the control hits the breakpoint below, it gets transferred to the code written in the Sheet.
Error encountered here.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("E1:E10"), Target) Is Nothing Then
'If Target.Offset(0, -2).Value = "" Then ' 1st check - e.g. C4 is empty OR
If Target.Offset(0, -3).Value Like "*stor*" Then ' 2nd check - e.g. B4 contains "*stor*"
' let the user change this cell
Else
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End If
End Sub
I'm creating a report-styled sheet in Excel, and trying to get a timestamp to automatically be entered in cell "P4" if cell "I6" has a value of "Completed"
I've tried using =IF formulas, which worked, but I'm unable to toggle iterative calculation on the machines this sheet will be working on.
I'm fairly new to writing my own VBA, and I'm having some trouble getting my current code to work. Below is what I currently have, which isn't giving me any results.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As String
Set r = Cells("I6")
If r.Value Is Nothing Then Exit Sub
If r.Value <> "Completed" Then Exit Sub
If r.Offset(-2, 7).Value <> "" Then Exit Sub
Application.EnableEvents = False
r.Offset(-2, 7) = Now()
Application.EnableEvents = True
End If
End Sub
I expect the code to give me a current timestamp in Cell "P4" once the value "Completed" is entered into cell "I6", but nothing is showing up. How would I correct it in order to get the value based timestamps?
As this sub is called at every cell's change (and you may use it later for other cell-checks also), check by Intersect first, if "your" cell is affected.
The changed range is given as Target (which may be a single cell or a complete range, e. g. when you paste on it). If that is intersected with your monitored cell I6, you can go ...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RelevantArea As Range
Set RelevantArea = Intersect(Target, Me.Range("I6"))
If Not RelevantArea Is Nothing Then
If Target.Value = "Completed" Then
Application.EnableEvents = False
Me.Range("P4").Value = Now()
Application.EnableEvents = True
End If
End If
End Sub
I have a table of values that I need to fill out through a worksheet change function.
What I am trying to do is change a cell in columns B-G, depending on where the target is.
Private Sub Worksheet_Change(ByVal Target As Range)
If (Not Intersect(Target, Range(Cells(12, 2), Cells(14, 7))) Is Nothing) Then
Cells(16,Application.WorksheetFunction.Column(Target))="Hello"
End If
End Sub
I have similar bits of code in the same worksheet_change sub that work fine when I use Target.Offset(1,0) but since my possible target range is in more than 1 Row, I don't know how to make it so that it is always row 16 and the same column as the target....
You need to deal with situations where Target is more than a single cell and disable event handling so when you change a value on the worksheet, the Worksheet_Change doesn't try to run on top of itself.
This will put 'hello' into the cell immediately to the right of any cell within B:G that changes; essentially you would be adding 'hello' to columns C:H on the associated row of each cell in Target.
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(target, Range(Cells(12, "B"), Cells(14, "G"))) is nothing then
on error goto safe_exit
application.enableevents = false
dim t as range
for each t in intersect(target, Range(Cells(12, "B"), Cells(14, "G")))
t.Offset(1,0) = "hello"
next t
End If
safe_exit:
application.enableevents = true
End Sub