Trigger Macro only when Cell Value is Increased - excel

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

Related

Using VBA Workbook_SheetChange only works in one direction

I am trying to use the Workbook_SheetChange feature of excel. I want to have multiple worksheets feed information into a master worksheet, and if you update a cell in a source sheet, the corresponding cell in the master sheet will also change, and vice versa.
Currently, I am starting small with just trying to get this thing to work with one cell so I can build on this. The code I have works, but only in one direction; when I edit something in the source sheet, the cell value in the master sheet changes to that new value. However, when I try to change the value in the master sheet, the value in the master sheet kinda bounces around until it finally decides to stick to the value derived from the source sheet. This only occurs whenever I try to have the cell portion of the address be the same between the two sheets; if the target cell in Sheet1 is $A$1 and the target cell in Sheet2 is any cell that is not $A$1, then there are no issues. This issue only occurs if the cell in both sheets is the same.
Below is the code that I am currently using.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
cell_1 = Worksheets("Sheet1").Range("$R$3").Address
cell_2 = Worksheets("Sheet2").Range("$R$3").Address
If Target.Address = cell_1 Or Target.Address = cell_2 Then
Call cellUpdate(Target.Address)
End If
End Sub
Sub cellUpdate(Target As String)
cell_1 = Worksheets("Sheet1").Range("$R$3").Address
cell_2 = Worksheets("Sheet2").Range("$R$3").Address
Application.EnableEvents = False
With ActiveWorkbook
If Target = cell_1 Then
Worksheets("Sheet2").Range("$R$3").Value = Worksheets("Sheet1").Range(Target)
ElseIf Target = cell_2 Then
Worksheets("Sheet1").Range("$R$3").Value = Worksheets("Sheet2").Range(Target)
End If
End With
Application.EnableEvents = True
End Sub
How do I get around this issue? I couldn't find any information online on how to avoid this since the uses I found for this Workbook_SheetChange function are for things that occur in one sheet rather than multiple sheets.
What is happening here is that you extensively use Target.Address. The issue with this is that Target.Address only returns the cell address, not the sheet it is on. For example it would return $A$1. Not Sheet1!$A$1. This means that in your if statement it tests whether "$A$1" = "$A$1" regardless of which sheet this address is on. Therefore it will only ever run the first clause of this loop resulting in it only working one way.
Secondly, you have a lot of redundant code, hard-coding a bunch of addresses multiple times. This can be massively simplified as demonstrated below:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell_1, cell_2 As Range
Set cell_1 = Worksheets("Sheet1").Range("$R$3")
Set cell_2 = Worksheets("Sheet2").Range("$R$3")
Application.EnableEvents = False
If Target = cell_1 Then
cell_2.Value = cell_1.Value
ElseIf Target = cell_2 Then
cell_1.Value = cell_2.Value
End If
Application.EnableEvents = True
End Sub
This code uses the first and second cell as range which stores the entire cell in memory, address, values, the lot. It then switches off EnableEvents as you did (good effort by the way, to prevent yourself from getting stuck in an infinite loop as most people would with this kind of code). Then it checks whether your target cell is cell 1 and switches the value of cell two with cell one, and the same for cell 2. No need for a separate function.
Couple of observations:
Worksheets("Sheet1").Range("$R$3").Address will always return the string $R$3, as will Worksheets("Sheet2").Range("$R$3").Address.
Both lines return exactly the same thing - it doesn't care what sheet it's on.
The Call statement isn't required.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
'Address is R3 on whichever sheet you're changing.
If Target.Address = "$R$3" Then
'Figure out which sheet was changed and update as required.
Select Case Sh.Name
Case "Sheet1"
Worksheets("Sheet2").Range("R3") = Sh.Range("R3")
Case "Sheet2"
Worksheets("Sheet1").Range("R3") = Sh.Range("R3")
Case "Sheet3", "Sheet4"
'Do stuff if you're on sheet 3 or sheet 4.
Case Else
'Do stuff if you're on any other sheet.
End Select
End If
Application.EnableEvents = True
End Sub

How to lock cells which are automated filled

I want to lock the cell after entering a value in it. When I change the value on sheet2 A1, the value should still be locked in B2.
When I enter "3" in Sheet2 A1 the number 2 should till be there.
Here the code I already have:
Private Sub Worksheet_Change(ByVal Target As Range)
Sheet1.Unprotect "1234"
If VBA.IsEmpty(Target.Value) Then
Target.Locked = False
Else
Target.Locked = True
End If
Sheet1.Protect "1234"
End Sub
My first answer was assuming that cell Locking referred to the Range.Locked property but now I understand that was intended to refer to the cell values and preventing them from recalculating.
There are a few techniques that can be used to prevent cells from recalculating. The easiest would be to just change any formulas into a static value like:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target.Value = Target.Value
Application.EnableEvents = True
End Sub
This event will get rid of every formula after it calculates its value the first time. Every cell will just be whatever value the user enters or whatever value the formula calculates the first time.
You can limit the range that the event will operate within by using Intersect like:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OperationalArea As Range, AffectedArea As Range
Set OperationalArea = Me.Range("B2:F10")
Set AffectedArea = Intersect(Target, OperationalArea)
If Not AffectedArea Is Nothing Then
Application.EnableEvents = False
AffectedArea.Value = AffectedArea.Value
Application.EnableEvents = True
End If
End Sub
This would limit the event to only change cells within the area "B2:F10" as defined in OperationalArea.
If you don't like this idea you can try messing about with Application.Calculation but it gets very messy when you have multiple sheets or workbooks open.
When you do Worksheet.Protect, every cell is locked by default. You need to specify which cells should still be editable (not locked) after protecting the sheet. In your case, you need to specify that every cell except your chosen few are not locked.
The second important note is that Worksheet.Protect has an option UserInterfaceOnly which when true, allows macros to continue editing cells without needing to unprotect the sheet first. This means you can leave the sheet protected and just unlock or lock cells as needed.
Here is an example of how to unlock every cell except A1 on Sheet1:
Sub Example()
With Sheet1
.Protect Password:="1234", UserInterfaceOnly:=True
.Cells.Locked = False
.Cells(1, 1).Locked = True
End With
End Sub

Selective disablement of certain cells for data entry during run time

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

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:

Combining 2 vba codes over 2 different ranges into one statement

I can make one or the other of the below codes work, but need them both. The first locks cells in range upon data entry, the second inserts a date stamp when the final data entry in column D of each row is completed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("A8:D5005"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="Midnight"
xRg.Locked = True
Target.Worksheet.Protect Password:="Midnight"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("D8:D5005")
If Not Intersect(Target, rng) Is Nothing Then
Target.Offset(0, 1) = Now
Target.Offset.NumberFormat = "dd/mm/yyyy hh:mm:ss"
End If
End Sub
I'm still guessing a bit exactly what you're trying to do … but here is way to allow your users enter four data points ... and then to press button to add the data points to a protected list … and includes a time stamp.
First setup 4 data entry cells in A4 through to D4 by using the Format Cell option, make sure for these cells that Locked is unchecked on the Protection tab.
Next create a button and link the button to the following code:
Sub ButtonCode()
ActiveSheet.Unprotect Password:="A"
Range("A7:E7").Insert xlShiftDown
Range("A4:D4").Copy Range("A7:D7")
Range("E7") = Now()
Range("A7:E7").Interior.Color = rgbLightBlue
Range("A7:E7").Font.Color = rgbBlack
ActiveSheet.Protect Password:="A"
End Sub
As a once only step, protect the worksheet; my example consistently uses a password of "A". Note that your users will not need to enter the password at any time.
Once the sheet is setup, when the button is clicked, the code unlocks the sheet (allowing it to make edits), it move the existing data data down, copy the new data points to the top of the list, adds timestamp and some minimal formatting. It then re-enables protection so that the user can't overwrite the existing entries.
The screenshot below gives you an idea of what it might look like, including showing that A4:D4 need to be unlocked.
Maybe not the implementation direction you were thinking of … but the principles included in this example might work for you. All the best.
I'm not 100% sure of the structure of your worksheet, so here are the assumptions for my response. You only want the user to modify cells in the range "A8:D5005" … and somewhere on the sheet you want to record date/timestamp changes for cells changed.
So I would start by protecting the sheet by going to the Excel "Review" ribbon (not in VBA), and setting up an editable range as follows.
Before you close the dialog box, click on Protect Sheet so that the rest of the sheet is password protected.
Once you've done this … you can use something like the code below to record the date/timestamps. In this example … I record them in columns to the right of your editable range (given your editable data is only to Column D).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vIntersect As Variant
Set vIntersect = Application.Intersect(Target, Range("A8:D5005"))
If Not vIntersect Is Nothing Then
Application.EnableEvents = False
Target.Worksheet.Unprotect Password:="Midnight"
Target.Offset(0, 5) = Now
Target.Offset(0, 5).NumberFormat = "dd/mm/yyyy hh:mm:ss"
Target.Worksheet.Protect Password:="Midnight"
Application.EnableEvents = True
End If
End Sub

Resources