Fire 'Worksheet_Change' event only when cell value is actually different - vba

I wrote code to extract data from the URL a particular page.
First time I run the code it extracts data from URL to cell C1.
I am at a point where I want to display a MsgBox whenever cell value changes.
For example:
First time I run the code "Happy" gets extracted to cell C1.
(Cell value changes, so msgbox "value changed")
The second time I run the code then Also "Happy" gets extracted to the cell C1.
(means no change, Noting happens)
The third time I run the code and "Sad" gets extracted to cell C1,
so at this point, I want a msgbox of the cell change.
I tried the below code but it shows the msgbox even when same values are changed in the cell.
For example - Cell contains text "Happy". I rewrite "Happy" in cell and press enter, so it displays msgbox of cell changed despite being same text in the cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:C10")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
MsgBox "Cell " & Target.Address & " has changed."
End If
End Sub

This uses Undo to check what the previous value of the cell was, and then compare it to the new value.
This will also not be case-sensitive, so HAPPY = HAPpy. If you want it to be case sensitive then remove the strconv functions.
Note that (any) of these procedures (including yours) will not react properly to multiple cells changing at once (like pasting in a range of cells), but you could add code to handle that however you needed to as demonstrated in the commented out lines.
But for single cells, this will do the trick:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, vNew, vOld
If Target.Cells.Count > 1 Then
MsgBox ("multiple cells changed: " & vbLf & Target.Address)
'to handle multiple cells changing at omce you'll need to loop like:
' dim c as cell
' for each c in Target.Cells
' ... etc
Exit Sub
End If
Set KeyCells = Range("A1:C10") ' cells to watch
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
vNew = Target.Value
Application.EnableEvents = False
Application.Undo
vOld = Target.Value
Target.Value = vNew
Application.EnableEvents = True
'make sure value is different (NOT case sensitive)
If StrConv(vNew, vbLowerCase) <> StrConv(vOld, vbLowerCase) Then
'do something here
MsgBox "Cell " & Target.Address & " changed" & vblf & _
"From: " & vOld & vblf & _
"To: " & vNew
End If
End If
End Sub
More Information:
MSDN : Application.Undo Method (Excel)
MSDN : Application.EnableEvents Property (Excel)
MSDN : Worksheet.Change Event (Excel)
Stack Overflow : How do I get the old value of a changed cell in Excel VBA? (Ronnie Dickson's answer)

Replace:
If Not Application.Intersect(KeyCells, Range(Target.Address))
with:
If Not Application.Intersect(KeyCells, Target)

Try it like this:
Public PrevValue
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Value <> PrevValue Then
MsgBox ("value changed")
PrevValue = Target.Value
End If
End Sub
The previous value is now stored in the global variable. When the value changes, it first checks if the value is the same as the previous value.
Edit:
If you change different cells each time, you can also use
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
PrevValue = Target.Value
End Sub
To set the value of the currenctly selected cell before the change.

Related

Message box to take the row number when multiple errors are shown

I am using this code to receive an error message every time when in column "W" a text is inserted. When this happens the text is deleted and a box message appears:"The row W" & r & " must contain only digits!" which tells the row number of the error. r - is set as Target.Row
My problem is that, when I copy a text in the range w10:w12, I receive the error message 3 times, which is great. But, in the message box it shows only row number w10 - 3 times i.e."The row W10 must contain only digits!" . How can I make the code to show the message box with w10, then w11 and lastly then w12?
Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range
Dim r As Long
r = Target.Row
Application.EnableEvents = False
For Each cell In Target
If Not Application.Intersect(cell, Range("w10:w10000")) Is Nothing Then
If Not IsNumeric(cell.Value) Then
MsgBox "The row W" & r & " must contain only digits!"
cell.Value = vbNullString
End If
End If
Next cell
Application.EnableEvents = True
[...] to receive an error message every time when in column "W" a text is inserted. When this happens the text is deleted and a box message appears:"The row W" & r & " must contain only digits!"
The right thing to do here, is to use Data Validation so as to restrict the possible values a cell can take.
You can specify an error message that Excel displays given an invalid value:
...and even a tooltip message when the cell is selected:
Here I've configured data validation for cell A1:
You can do all that with VBA code (using the Range.Validation API), but really there's no need at all.
Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range
Application.EnableEvents = False
For Each cell In Target
If Not Application.Intersect(cell, Range("w10:w10000")) Is Nothing Then
If Not IsNumeric(cell.Value) Then
MsgBox "The row W" & cell.row & " must contain only digits!"
cell.Value = vbNullString
End If
End If
Next cell
Application.EnableEvents = True
It would be easier to get intersected range first and then checking those cells:
Sub F()
Dim cell As Range
Dim rngArea As Range
Dim rngIntersect As Range
Set rngIntersect = Intersect(Selection, [W10:W10000])
If rngIntersect Is Nothing Then Exit Sub
For Each rngArea In rngIntersect.Areas
For Each cell In rngArea
'// The code...
Next
Next
End Sub

Excel VBA Worksheet_Change

I have code that checks for text in a range of cells and opens a MsgBox
The code works well until I delete a range of data both from using a macro for ClearContents and selecting a range of cells and using the delete button. No error if I delete cell contents one cell at a time.
The original code would trigger the MsgBox for every change; I just want it to trigger based on the entry of "Not Met" from a pick list.
The error I get is this:
Run-time error '13': Type mismatch
Following is the modified code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("E3:E41")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If Target.Value = ("Not Met") Then
MsgBox "Make sure you enter Gaps, Actions and a Priority Rating"
End If
End If
End Sub
There is no real need to have a Range variable to keep the the Range("E3:E41"), you can do it directly with If Not Intersect(Range("E3:E41"), Target) Is Nothing Then.
Note: Since Target is a Range, there is no need to use it with Range(Target.Address) , Target alone will do it.
Code (short version)
Private Sub Worksheet_Change(ByVal Target As range)
If Not Intersect(Range("E3:E41"), Target) Is Nothing Then
' Display a message when one of the designated cells has been changed
If Target.Value = ("Not Met") Then MsgBox "Make sure you enter Gaps, Actions and a Priority Rating"
End If
End Sub
This should give you what you are after:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("E3:E41")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If Target.Count = 1 Then
If Target.Value = ("Not Met") Then
MsgBox "Make sure you enter Gaps, Actions and a Priority Rating"
End If
End If
End If
End Sub

Notification message upon cell change

So I want a message to appear when a cell changes that notifies somebody when the cell is changed. The cells that change are referenced from cells in another workbook. Here is my code so far, but it only works when I manually change the cells. It doesn't work when I change the cell being referenced.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B2:P43")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Beep
MsgBox "Cell " & Target.Address & "has changed."
End If
End Sub
Try fully qualifying the Ranges, like this:
Set KeyCells = Sheet1.Range("B2:P43")

excel vba on cell change error

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Range = Range("A1") Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
that's the code however when i copy paste a set off cell, let's say 2 columns and 3 rows
it produce runtime error 13 type mismatch on line
If Target.Range = Range("A1") Then
why?
i simply wants the vba to do something everytime cell A1 changes
the value of A1 itself is an excel sum formula
You get type-missmatch error, becase you're trying to compare range (containing many cells) with single cell. If you want to do something every time cell A1 changed, use this one instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ErrHandler
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
ExitHere:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Resume ExitHere
End Sub
also note that I'm using Application.EnableEvents = False - it's a good habbit for Worksheet_Change event to use it. It prevents code from infinity firing itself each time you change any cell in event handler code.
UPD:
Btw, the value of A1 itself is an excel sum formula - you can't track changes of formula using above approach. I covered in details how you can do it in this question: Using Worksheet_Calculate event for tracking changes of formula
Simoco's answer should work for you. Another way (the one I usually use, though only out of habit) is to compare the addresses:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A1").Address Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
You are getting an error because Target.Range is not defined. You should either just refer to Target (a Range Object) or Target.Address (the address of the Range Object). Secondly, depending on the context, Range("A1") refers to either the cell A1 itself (a Range Object) or the value in cell A1 (a literal value). You need to carefully think what you want to compare to what.
If, as you said, you want the comparison done whenever the value in Range("A1") changes then you should follow Simoco's suggestion.

VBA trigger macro on cell value change

This should be simple. When the value of a cell changes I want to trigger some VBA code. The cell (D3) is a calculation from two other cells =B3*C3. I have attempted 2 approaches:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row = 3 Then
MsgBox "There was a change in cell D3"
End If
End Sub
Since the cell is a calculation this is not triggered when the value changes, because the calculation remains the same. I also tried:
Private Sub Worksheet_Calculate()
MsgBox "There was a calculation"
End Sub
But I have multiple calculations on the sheet and it triggers multiple times. Is there a way I can identify which calculation changed on the calculation event? Or is there another way I can track when D3 changes?
Could you try something like this? Change the formula to =D3AlertOnChange(B3*C3).
Private D3OldVal As Variant
Public Function D3AlertOnChange(val)
If val <> D3OldVal Then MsgBox "Value changed!"
D3OldVal = val
D3AlertOnChange = val
End Function
Or try
Private Sub Worksheet_Change(ByVal Target As Range)
Dim numdependences As Integer
On Error Resume Next
HasDependents = Target.Dependents.Count
If Err = 0 Then
If InStr(Target.Dependents.Address, "$D$3") <> 0 Then
MsgBox "change"
End If
End If
On Error GoTo 0
End Sub
You need the error control in case you change a cell that has not dependents.
try this:
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B1")) Is Nothing Then
Call macro
End If
End Sub
looks for a change in value of cell B1, then executes "macro"
If you are only looking at if the Worksheet_Change then it will count a change for anything entered even if it is the same as the previous value. To overcome this I use a Public variable to capture the starting value and compare it.
This is my code to do this. It also allows you omit parts of the worksheet or you can use it to evaluate every cell in the worksheet.
Place this code in the Worksheet.
Public TargetVal As String 'This is the value of a cell when it is selected
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then 'If more then one cell is selected do not save TargetVal. CountLarge is used to protect from overflow if all cells are selected.
GoTo EXITNOW
Else
TargetVal = Target 'This sets the value of the TargetVal variable when a cell is selected
End If
EXITNOW:
End Sub
Sub Worksheet_Change(ByVal Target As Range)
'When a cell is modified this will evaluate if the value in the cell value has changed.
'For example if a cell is entered and enter is pressed the value is still evaluated
'We don't want to count it as a change if the value hasn't actually changed
Dim ColumnNumber As Integer
Dim RowNumber As Integer
Dim ColumnLetter As String
'---------------------
'GET CURRENT CELL INFO
'---------------------
ColumnNumber = Target.Column
RowNumber = Target.Row
ColumnLetter = Split(Target.Address, "$")(1)
'---------------------
'DEFINE NO ACTION PARAMETERS
' IF CELL CHANGED IS IN NO ACTION RANGE, EXIT CODE NOW FOR PERFORMANCE IMPROVEMENT OR TO NOT TAKE ACTION
'---------------------
If ColumnNumber <> 4 Then 'This would exempt anything not in Column 4
GoTo EXITNOW
ElseIf RowNumber <> 3 Then 'This would exempt anything not in Row 3
GoTo EXITNOW
'Add Attional ElseIf statements as needed
'ElseIf ColumnNumber > 25 Then
'GoTo EXITNOW
End If
'---------------------
'EVALUATE IF CELL VALUE HAS CHANGED
'---------------------
Debug.Print "---------------------------------------------------------"
Debug.Print "Cell: " & ColumnLetter & RowNumber & " Starting Value: " & TargetVal & " | New Value: " & Target
If Target = TargetVal Then
Debug.Print " No Change"
'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF NOT CHANGED
Else
Debug.Print " Cell Value has Changed"
'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF CHANGED
End If
Debug.Print "---------------------------------------------------------"
EXITNOW:
End Sub