VBA trigger macro on cell value change - vba

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

Related

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

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.

Excel VBA: How to autocreate hyperlink from cell value?

I have a table called Table1
In Column B, I have the ticket number. e.g: 76537434
Requirement: when any change happens in any cell in column B, that cell (Target cell) to be changed into a hyperlink such that the hyperlink address would be example.com/id=76537434
Cell value i.e. 76537434 must remain the same
Add this event handler to your worksheet's code module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Target.Hyperlinks.Delete ' or Target.ClearHyperlinks to conserve the formatting
Me.Hyperlinks.Add Target, "http://example.com/id=" & Target.value
End Sub
The following Worksheet_Change event should be able to solve your problem:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim tmp As String
If Intersect(Range("B:B"), Target) Is Nothing Then Exit Sub
For Each cell In Target
If cell.Column = 2 Then
Application.EnableEvents = False
tmp = cell.Value2
cell.Parent.Hyperlinks.Add _
Anchor:=Cells(cell.Row, 2), _
Address:="http://example.com/id=" & tmp, _
TextToDisplay:=tmp
Application.EnableEvents = True
End If
Next cell
End Sub
Note, that you must copy it to the sheet and not into a separate module.
=HYPERLINK(E14&F14,"Name")
where cell E14 contains "http://www.example.com/id=" and cell F14 contains "76537434".
This soultions doesn't need VBA macros.

How to run macro if based on other cells which automatically changes by formula

As per subject, what I need is to run macro based on other cells.
Here is the case :
cells G3 until the end of row contains data used formula =IF(B3="";"";(SUMIF('Incoming Goods'!$F$3:$F$1048576;'Current Stock'!B3;'Incoming Goods'!$M$3:$M$1048576)-(SUMIF('Outgoing Goods'!$D$4:$D$1048576;'Current Stock'!B3;'Outgoing Goods'!$J$4:$J$1048576))))--> i need to convert this formula to VBA
cells H3 should contain : If G3.value = 0 then "Out of Stock", else " "
And this sheet must be calculate every time data in G3 change automatically or any additional data on this sheet.
Already tried this code :
Private Sub Worksheet_Calculate()
Dim Current As Worksheet
Dim Rng1 As Range
Dim Target As Range
Set Current = Worksheets("Current Stock")
Set Rng1 = Current.Range("G:G")
Set Target = Range("H:H")
For Each Rng1 In Target
If Rng1.Value2 = "0" Then
Target.Value2 = "Out Of Stock"
Else
Exit Sub
End If
Next
End Sub
However, above code is Not working. Already try using Private Sub Selection Change() and Private Sub Selection Change() but still not working.
Any suggestion?
Thanks in advance
the answer to the first part is below:
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]="""","""",(SUMIF('Incoming Goods'!R3C6:R1048576C6,'Current Stock'!R[2]C[1],'Incoming Goods'!R3C13:R1048576C13)-(SUMIF('Outgoing Goods'!R4C4:R1048576C4,'Current Stock'!R[2]C[1],'Outgoing Goods'!R4C10:R1048576C10))))"
handy tip: to convert any excel formula to code, hit the record macro button, then click on the cell, press F2 key, then press enter, and stop recording macro. The code will now be in its own module in the vba editor.
This should do what you want.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call YourMacroName
End If
End If
End Sub

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 (Excel): Jump to (or remain) cell in column

I would like to start off with stating that I have virtually no coding experience. I found a VBA snippet online for highlighting an entire selected range (just to as a visual guide):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
I would like to also have the cursor jump-to column "J". For instance, after performing a search for cells containing the words "strawberry topping" after pressing 'OK' the cell containing that text becomes active and, due to the VBA code, the entire row is highlighted.
The first cell I need to work on is in column "J". Can I also have column J selected along with the row being highlighted?
Thank you so much for your time and would appreciate any help you may have to offer.
My Three cents
If you are using xl2007+ then do not use Target.Cells.Count. Use Target.Cells.CountLarge else you will get an Overflow error if a user tries to select all cells by pressing CTRL + A as Target.Cells.Count can't hold a Long value.
If you want to select the row and the column, you might want to switch off events else you might end up in endless loop.
Since you are working with events, use error handling.
Is this what you are trying?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rw As Long, Col As Long
Dim ColName As String
On Error GoTo Whoa
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
' Clear the color of all the cells
'Cells.Interior.ColorIndex = 0
With Target
Rw = .Row
Col = .Column
ColName = Split(Cells(, Col).Address, "$")(1)
' Highlight the entire column that contain the active cell
'.EntireRow.Interior.ColorIndex = 8
Range(ColName & ":" & ColName & "," & Rw & ":" & Rw).Select
End With
LetsContinue:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
End Sub