Automatically run Excel VBA macro when cell value changes - excel

I need a macro that calls another macro when the value in cell A1 changes.
At the moment I am using the following code, but it seems to call the "pageupdate" sub every time the page recalculates, rather than just when the value in A1 actually changes from 0 to 1.
Does this issue stick out at anyone who understands the "Worksheet_Calculate" sub type or the logic behind the if statement.
Private Sub Worksheet_Calculate()
'|-------------------------------------------------|
'| Run Pageupdate |
'|-------------------------------------------------|
'If cell A1 recalculates affected by a change in the sheet/s, then this macro runs the 'PageUpdate' Macro.
'The point of this is to prevent the PageUpdate running when it doesn't need to.
Static OldVal As Variant
If Range("A1").Value <> OldVal Then
OldVal = Range("A1").Value
Call PageUpdate
End If
End Sub

Add the following sub as a Macro attached to the sheet you want to be
affected by the update and put your code inside this macro.
You can find the solution here
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:A1")
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

Related

Trigger Macro only when Cell Value is Increased

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

Queue macro by changing Cell.Font.Bold

I know there is an option to queue a macro by clicking into a cell. (Worksheet_SelectionChange)
But is there also an option where the macro gets queued if I change the cell font boldness?
I always want to start the macro when I change a cell to "bold".
I guess you might program your custom event for that specific case. A more simple approach can be to check if determined cell o cell in a determined range is put to bold and the call the macro.
Find a example where the msg is thrown when a bold cell is found in the range "A1:C10". It is triggered on selection change (so when pressing enter after setting the cell to bold).
You would need to call the macro you want where the message is thrown.
Private Sub Worksheet_SelectionChange(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."
For Each cell In KeyCells
If cell.Font.Bold = True Then
MsgBox ("a cell is bold!")
End If
Next cell
End If
End Sub

How do I Autofill a cell with string depending if it's in another list?

I'm trying to create a sheet where I can type one text value in and it autofills with the closest possible match from another list of strings.
I've tried using the VLOOKUP function in VBA, with 4th argument set to TRUE to look for a partial match. I've also tried using the VLOOKUP function in excel only and not VBA. The result is half of what I want, let's say I enter "cookie" in the cell, the function returns "Cleaning Supplies" since they both start with a C. Ideally, I'd want it to return Chocolate Cookie or something similar to that.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Target.Value = Application.WorksheetFunction.VLookup(Target.Value, Worksheets("StorageLocations").Range("A:A"), 1, True)
End If
End Sub
The code works partially, coming back with a run-time error Method 'Range' of object_ '_Worksheet' failed. It also only comes back with the cleaning supplies comment from earlier.
Any help is appreciated.
Try:
In Worksheet event paste
Private Sub Worksheet_Change(ByVal Target As Range)
Call fnd(Target)
End Sub
In a New Module Paste
Sub fnd(rng As Range)
Application.EnableEvents = False
If rng.Column = 1 Then
If Not Worksheets("StorageLocations").Range("A:A").Find(rng) Is Nothing Then
rng.Value = Worksheets("StorageLocations").Range("A:A").Find(rng.Text).Value
End If
End If
Application.EnableEvents = True
End Sub
Explanation:
We need this Enable Events to change the value in Sheet, otherwise while changing the cell value it will keep firing the Change Event.
It will always give you the First available Match in the Column
Demo:

worksheet cell value change for a loop of cells

So i am currently using a classic "Run macro if Cell changes value":
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Call Macro A
End if
End Sub
Now i want to extend the macro so it checks every cell in the range Range("O1:O40"), and run a different macro depending on which cell that changes value.
The different macros could be placed in a loop, as the code is essentially:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("O1"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N1").Value = Worksheets("Input").Range("O1").Value
ElseIf Not Application.Intersect(Range("O2"), Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N2").Value = Worksheets("Input").Range("O2").Value
End if
End Sub
so if Worksheets("Input").Range("O1") changes value, the value must be copied to Worksheets("Data").Range("N1"), and so forth for all the cells in range "O1:O40"
You can run through the range using a For Each Loop
Dim cell As Range
For Each cell In Range("O1:O40")
If Not Application.Intersect(cell, Range(Target.Address)) Is Nothing Then
Worksheets("Data").Range("N" & cell.row).Value2 = cell.Value2
End If
Next cell

Type Mismatch error with cell selection

I created this basic worksheet_change function which monitors column B. If a cell in column B gets deleted, it updates the delete in column C as well. The only issue is that since this is a change event, when more then 2 cells are altered at once, it throws a type mismatch error. This is because its comparing the Target.Address(s) to "" which is a type mismatch. How can I fix this to only run if only a single cell is select and not crash on a multiple cell select?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B2:B51")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If Range(Target.Address).Value = "" Then
Range("C" & Target.Row).Clear
End If
End If
End Sub
To simply check if the Target Range changed is more than one cell, you can simply count the cells in the range.
As mentioned in the comment, right after you declare the sub, you can add:
If Target.Count > 1 Then Exit Sub.
Alternatively, of course you could do, If Target.Count = 1 Then ...
Edit: Per your question above, you can do this to make sure events are on:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Application.EnableEvents = True
Exit Sub
End If
' Code here that will run, if the Target is just one cell
End Sub

Resources