Take as example the following code which should state whether the content of Cell A3 is greater or smaller than 0.25, where in Cell A3 we have a formula like RAND() whoch generates random numbers between 0 and 1.
Private Sub Worksheet_Change(ByVal Target As Range)
Calculate
If Range("A3") > 0.25 Then
Range("B3") = "greater than 0.25"
Else: Range("B3") = "smaller than 0.25"
End If
End Sub
How to make this Event conditions to be verified in continuous time?
What about using timer? this function calls each 1 second
Sub Test()
Calculate
If Range("A3") > 0.25 Then
Range("B3") = "greater than 0.25"
Else
Range("B3") = "smaller than 0.25"
End If
Application.OnTime Now + TimeSerial(0, 0, 1), "Test"
End Sub
I think there is no option for that. Have been looking for it myself. There is no change event for calculated cells. The only option is to check dependencies of a calculated field but in this case there are none.
Related
I'm trying to make my shape change height automatically, based on what is in a cell, when that cell value is changed.
The tricky part is that it would be 1" of height per every 1000 inputted into that cell.
I thought it would be something like the below, but that's based on ranges and doesn't take the ratio into consideration and is pretty tedious.
Private Sub Worksheet_ShapeHeight()
If Range("C8").Value >= 1000 And Range("").Value <= 2000 Then
Shapes("Rectangle 1").Height = 1
Else
If Range("C8").Value >= 2000 And Range("").Value <= 3000 Then
Shapes("Rectangle 1").Height = 2
'---And so on..
End Sub
Screenshot of Sheet1
Perhaps something like the following. Note that the unit for Shape.Height is points, not inches.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("C8")) Is Nothing Then Exit Sub
Dim calcHeight As Single
calcHeight = Int(Me.Range("C8").Value / 1000) * 72 ' 72 points per inch
Me.Shapes("Rectangle 1").Height = calcHeight
End Sub
I am creating a function where if a cell has Yellow color and if I enter 0 in that cell, then it pops up a message box Red then colors the cell Red. And then if I enter 1 it reverts the color to Yellow.
Here's my code:
Function ColorChange(range)
If range.Interior.ColorIndex = 6 And range.Value < 1 Then
MsgBox "Project Delay!", vbCritical, "Attention required!"
range.Interior.ColorIndex = 3
Else
If range.Interior.ColorIndex = 3 And range.Value > 0 Then
range.Interior.ColorIndex = 6
End If
End If
End Function
1) It is not necessary to use a function. In VBA you can program classically (and run the macro manually) or you can program event. It means that a macro will be running in case of a particular event (like a mouse-click or a modification in the sheet). That is why Siddarth Rout spoke about Worksheet_change, it is an event. In this case, define your Sub in this way and the following code will be executed in case of Worksheet modification.
2) You have to define a Private Sub for the specific worksheet. Private Sub Worksheet_change() and you put in argument ByVal Target As range. It means that you will receive information about the range that have been changed (Target).
3) After you will use Target.Address to define the range used by your code.
4) Your 2 intricate if statements are not necessary. It is better to use an if statement and an else if statement.
5) The following code is OK for me:
Private Sub Worksheet_change(ByVal Target As range)
If range(Target.Address).Interior.ColorIndex = 6 And range(Target.Address).Value < 1 Then
MsgBox "Project Delay!", vbCritical, "Attention required!"
range(Target.Address).Interior.ColorIndex = 3
ElseIf range(Target.Address).Interior.ColorIndex = 3 And range(Target.Address).Value > 0 Then
range(Target.Address).Interior.ColorIndex = 6
End If
End Sub
I'm making a form to calculate the price rooms we rent out. Among others this cost is based on the arrival and departure date. You can see a screenshot of the form below;
- "Aankomst" (the first date) means "Arrival"
- "Vertrek" (the second date) means "Departure"
As you can see, I added buttons to respectively decrease or increase the dates. I also made sure that impossible values would be rectified. The departure date can never be equal or lower than the arrival date. When trying to decrease the departure date, or increase the arrival date, this is triggered when wrong.
When inputting values manually, this check does not occur. A bit of searching learned me I could do this with a change event macro.
I wrote this bit of code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$B$5" And Range("$b$5").Value + 1 >= Range("$b$6").Value Then
Range("$b$6").Value = Range("$b$5").Value + 1
End If
If Target.Address = "$B$6" And Range("$b$6").Value - 1 <= Range("$b$5").Value Then
Range("$b$5").Value = Range("$b$6").Value - 1
End If
Application.ScreenUpdating = True
End Sub
B5 is the cell containing the arrival date, b6 is the cell containing the departure date. When triggered, this macro should check both which cell was changed (b5 or b6) and if the arr. date is equal to or higher than the dep. date. And if so, automatically change the other cell (the one that was not manually changed).
Now when I omit the second if-statement, it works just fine. If I omit the second if-statement, it works fine as well. When both statements are active, it bugs everytime. I get a prompt saying 'insufficient stacking space' (translated from dutch).
I've tried this code as well, using case:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Range("b6").Value - 1 <= Range("b5").Value Then
Select Case Target.Address(0, 0)
Case "b5": Range("vertrek").Value = Range("aankomst").Value + 1
Case "b6": Range("aankomst").Value = Range("vertrek").Value - 1
End Select
End If
Application.ScreenUpdating = True
End Sub
...but also without success, same error. When I debug, I can see that the date was indeed changed if necessary, so I presume I somehow create an infinite loop or smth and that causes Excel to bug.
Does anyone know where my error lies or anyone aware of another method to achieve my goal?
Protect against re-raising the same event over and over:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Address = "$B$5" And Range("$b$5").Value + 1 >= Range("$b$6").Value Then
Range("$b$6").Value = Range("$b$5").Value + 1
End If
If Target.Address = "$B$6" And Range("$b$6").Value - 1 <= Range("$b$5").Value Then
Range("$b$5").Value = Range("$b$6").Value - 1
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I'm looking for a way for excel to alert me when a dynamic value (market feed data) is out of line by x%. The alert needs to appear in front of all my windows with a msg box "CHECK VALUES".
Is this possible to do and has anyone have an example of code for this?
More specifically
Minimum difference = 0.5
CELL A = 10
CELL B = 11
Difference = 1
ALERT user "Difference > 0.5"
Thank you in advance.
Thank you. This works perfect. Now I understand how it works, I'm hoping for another solution similar to the above. Both cells in A1 and B1 are constantly changing(variables). Cell C1 is the =ABS(B1-A1). What I need now is a code to alert me when Cell C1 is greater than 0.5.
You can use worksheet_change event. Try below code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo err_rout
Application.EnableEvents = False
If Target.Address = "$A$1" And Target.CountLarge = 1 Then
If (Target.Value - Target.Offset(0, 1)) > 0.5 Then
MsgBox "CHECK VALUES"
End If
ElseIf Target.Address = "$B$1" And Target.CountLarge = 1 Then
If (Target.Value - Target.Offset(0, -1)) > 0.5 Then
MsgBox "CHECK VALUES"
End If
End If
err_rout:
Application.EnableEvents = True
End Sub
Ok I have a worksheet "Goal 0" that with some ranges, make some calculations like...
(in A1)
=SUM(G2:G68)*I17
Then if I add/modify any of the values in 62-G68, the cell is auto calculated (numbers that are mainly negative and some possitive).
The objetive is: According to the sum of the range, find the value of I17 where the result of A1 is equal or more than 0. (Starting from 0, incrementing it 1 by 1, decimals not needed)
Manually I can add change i17 untill it reaches the goal. How ever I want to make it automatically, so if a value in the range of G2 to G68 changes it recalculate the value of I17, untill (A1 calculation gets value equal or higher than 0) but if already is higger or equal than 0 then do nothing.
Hope I explain it well
EDIT: Now I created this code ...
Function IncreaseTheValue()
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
End Function
And works perfect, how ever it does not fires when I make a chage. How do I do that...
I try adding this in A2 cell but did not worked ...
=IF(A1 < 0, IncreaseTheValue(), "")
Regards
You shouldn't really be doing this as a Function; it is inadequate as you notice, but also not appropriate use of a Function where a Sub or event handler is more appropriate.
Based on your requirements, put the code in the Worksheet_Change event handler. You will need to fine-tune it so that it only fires when a change is made in the range G2:G68.
Try this (untested):
Private Sub Worksheet_Change(ByVal Target as Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("G2:G68")) Is Nothing Then
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
End If
Application.EnableEvents = True
End Sub
Updated per pnuts comments. This method below will trigger the macro any time any cell changes -- this might be overkill, or it might be necessary if G2:G68 is formulas which change based on changes to other cells. Either method can be fine-tuned to better suit your exact needs.
Private Sub Worksheet_Change(ByVal Target as Range)
Application.EnableEvents = False
If Range("A1") < 0 Then
Range("I17").Value = 0
Do While Range("A1").Value < 0
Range("I17").Value = Range("I17").Value + 1
Loop
End If
Application.EnableEvents = True
End Sub