I´ve done some extensive research, but cannot solve my problem. I have an Excel workbook where I constantly pull a value from an OPC server. The value is stored in a set of rows. This works perfectly whenever I introduce the data manually, but when the cell is automatically updated, it does not work.
Private Sub Worksheet_Change(ByVal target As Range)
'MsgBox = Target.Address
If Not Application.Intersect(Range("B1:B2"), Range(target.Address)) Is Nothing Then
Call CopyDataToRecord
End If
End Sub
Sub CopyDataToRecord()
Dim IndexI As Integer
Dim IndexY As Integer
Dim IndexMius As Integer
Dim DufferLength As Integer
DufferLength = 20
IndexY = DufferLength + 5
'Shift Data
For IndexI = i To DufferLength
IndexYMius = IndexY - 1
Cells(IndexY, 1) = Cells(IndexYMius, 1)
Cells(IndexY, 2) = Cells(IndexYMius, 2)
IndexY = IndexYMius
Next IndexI
'Copy The Latest Data
Range("A2:B2").Copy Range("A5:B5")
End Sub
Your code (a bit adapted to declare i and IndexYMius) works well on my Excel sheet.
I would just recommend to prevent recursive Worksheet_Change calls by protecting the changes with Application.EnableEvents:
Private Sub Worksheet_Change(ByVal target As Range)
'MsgBox = Target.Address
If Not Application.Intersect(Range("B1:B2"), Range(target.Address)) Is Nothing Then
Application.EnableEvents = False
Call CopyDataToRecord
Application.EnableEvents = True
End If
End Sub
BTW, if your code is not triggered by the automatic update process, it might be because this process includes somewhere an Application.EnableEvents = False that prevents the Worksheet_Change to be executed.
Related
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("B12").Address Then
Application.EnableEvents = False
Dim sOldValue As String, sNewValue As String
sNewValue = Target.Value
Application.Undo
Dim rOld As Range
Set rOld = Range("A1:E1").Value
Target.Value = sNewValue
Range("A15:E15").Value = rOld.Value
Application.EnableEvents = True
End If
End Sub
How to run this function, can you please call this function?
Create a button, add in the following code, you might need to change your code from Private to Public
`Private Sub CommandButton1_Click()
Call Worksheet_Change
End Sub`
The code you posted is for the Worksheet.Change event. The event occurs when cells on the worksheet are changed by the user or by an external link.
All you need to run this sub is to place the code in the sheet module for the relevant sheet and change B12 cell.
A Worksheet Change: Change Range Values on Cell Change
Worksheet_ in the signature Private Sub Worksheet_Change(ByVal Target As Range) indicates that this procedure belongs in the sheet module, e.g. Sheet1, of the worksheet where you want it applied (not in the ThisWorkbook module nor in a standard module, e.g. Module1). Such a procedure will run automatically (get triggered) when an event occurs, particularly for this procedure, after a manual change has happened in a range i.e. after
you write something into the formula bar and press enter,
you (copy) paste values to a range, or
you use VBA to write values to a range.
In this procedure, if you want to write something to a range of the worksheet, to not retrigger the event and possibly end up with an endless loop ('crashing' Excel), you will disable events before you start writing, and enable them after writing as you did in your code. If an error occurs between these two lines, the events will stay disabled and the code won't trigger until they are enabled again.
To check if events are enabled you could use the line Debug.Print Application.EnableEvents in another procedure or in the Immediate window just use ?Application.EnableEvents and press enter. Similarly, if the answer is False, in the Immediate window, you can use Application.EnableEvents = True and press enter to enable events.
The line Set rOld = Range("A1:E1").Value is wrong and results in
Run-time error '424': Object required
To avoid the error you could use one of the following:
Dim rgOld As Range: Set rgOld = Range("A1:E1")
Range("A15:E15").Value = rgOld.Value
Target.Value = sNewValue
Dim OldValues() As Variant: OldValues = Range("A1:E1").Value
Range("A15:E15").Value = OldValues ' or after the following line
Target.Value = sNewValue
Range("A15:E15").Value = Range("A1:E1").Value
Target.Value = sNewValue
Basically, you want to write the data before rewriting the new value. Optionally, in the second case where the data is written to an array (OldValues), you can write the values afterward.
Since the use of an additional variable is kind of redundant in the first two cases, the last (the simplest, the most straightforward) case is used in the following code.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$12" Then Exit Sub
Dim NewString As String: NewString = CStr(Target.Value)
Application.EnableEvents = False
Application.Undo ' this will also write (trigger the event)
Me.Range("A15:E15").Value = Me.Range("A1:E1").Value
Target.Value = NewString ' redo
Application.EnableEvents = True
End Sub
If you want to modify (experiment with) the code, you should introduce some error handling so you don't end up with events disabled.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ClearError
If Target.Address <> "$B$12" Then Exit Sub
Dim NewString As String: NewString = CStr(Target.Value)
Application.EnableEvents = False
Application.Undo ' this will also write (trigger the event)
Me.Range("A15:E15").Value = Me.Range("A1:E1").Value
Target.Value = NewString ' redo
SafeExit:
On Error Resume Next
If Not Application.EnableEvents Then Application.EnableEvents = True
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error'" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
One thing is basic: how did you create this function? Did you open the Excel VBA editor, select a sheet and chose the corresponding event, like I did in the following screenshot:
As you see, the macro is linked to "Sheet1", it is linked to the events of the "Worksheet" itself, and it is triggered by any "Change" of that worksheet.
I have a formula that makes an API request every time it's executed, which makes it slow. I'd like to prevent Excel from automatically recalculating cells containing this formula but still automatically recalculate other cells.
I've tried setting calculation mode to Manual with:
Application.Calculation = xlCalculationManual
However this prevents other cells without my formula from calculating automatically.
Another idea I've had is to check if a cell has been "frozen" and then return it's current value instead of calling the API for a new value. The issue with this is that Excel doesn't provide a way to exit the function without altering the cell value.
Function MyFormula() As Variant
If CellIsFrozen() Then
MyFormula = Application.Caller.Value 'return current value
Else
MyFormula = GetNewValueFromAPI() 'expensive call to server
End If
End Function
My issue with the above is that Application.Caller.Value returns the cell value by performing a recalculation and results in an infinite recursion.
FYI - the CellIsFrozen method is just an example sub that would somehow check whether the cell was called automatically or manually.
I'm also aware of Application.Caller.Value2 and .text, unfortunately these don't help me. Value2 also causes a recalculation, and text just returns a string representation (which is not useful because it could be "######" if the value is a date and the column is too narrow).
Is there a way to interrupt Excel's recalculation process for specific formulas?
Otherwise, is it possible to extract a value of a cell without performing a recalculation - I'm guessing that Excel stores the value somewhere because it's visible on the worksheet, it makes no sense to insist on recalculating every time.
In the context my previous answer to the post involving single cell, i also want share our old experience involving multiple cells. that days We used the formula in an indexed fashion like =myformula(1)... etc and stored it in a global array. Now today thanks to your great idea of Caller function. I recreated another improvised solution involving multiple cells.
Here again in module1
Global Flag As Boolean, LastValArr(1 To 10, 1 To 2) As Variant, Ws As Worksheet, Rng As Range
Public Function MyFormula() As Variant
Dim Adr As String, X As Integer
If Flag Then
MyFormula = GetNewValueFromAPI() 'expensive call to server
Else
Adr = Application.Caller.Address
For X = 1 To 10
If InStr(1, LastValArr(X, 2), Adr) > 0 Then
MyFormula = LastValArr(X, 1)
Exit For
End If
Next
End If
End Function
Function GetNewValueFromAPI() As Variant
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function
Sub CalcA1()
Flag = True
Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
Sub ToggleFlag()
Flag = Not Flag
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
If Flag Then Rng.Dirty
End Sub
in Workbook_Open event
Private Sub Workbook_Open()
Dim X As Integer
Dim Cell As Range
Set Ws = ThisWorkbook.Sheets("Sheet1")
Set Rng = Ws.Range("A1:A5")
Set Rng = Union(Rng, Ws.Range("C1:C5"))
Flag = True
Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
in Sheet1 Worksheet_Calculate event
Private Sub Worksheet_Calculate()
Dim X As Integer
Dim Cell As Range
X = 1
For Each Cell In Rng.Cells
LastValArr(X, 1) = Cell.Value
LastValArr(X, 2) = Cell.Address
X = X + 1
Next
End Sub
Edit: On second thought after initial feel good of posting the Demo answer, I found it lacks User friendliness and ease of copy pasting UDF formulas while working in Excel Therefore i tried improvise it further so it could be used by users don't have access to VBA code and could work with copy paste of the UDF.
So 1st I came across a solution to store the Last Values in a temp sheet (may be Very Hidden Sheet). with apprehension that working with cell access may degrade performance of the code, I refrained from posting it and I finally restored to Dictionary Object.
This solution have added with basic advantage of Auto mapping of formula cells (by searching "=myformula" in used range of the Sheet) to enable/disable calculation. This would enable users without access to code modules to work freely with UDF.
Here reference to Microsoft scripting runtime has been added.
Code in module:
Global Flag As Boolean, Ws As Worksheet, Rng As Range, Dict As Dictionary
Public Function MyFormula() As Variant
Dim Adr As String
If Flag Then
MyFormula = GetNewValueFromAPI() 'expensive call to server
Else
Adr = Application.Caller.Address
'Debug.Print Adr
MyFormula = IIf(Dict.Exists(Adr), Dict(Adr), 0)
End If
End Function
Function GetNewValueFromAPI() As Variant
'Delay (2)
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function
Sub CalcA1()
Flag = True
If Not Rng Is Nothing Then Rng.Dirty
'Debug.Print "in calA1"
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
Sub ToggleFlag()
Flag = Not Flag
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
If Flag And Not Rng Is Nothing Then Rng.Dirty
End Sub
Sub BuildRange()
Application.EnableEvents = False
Dim Cell As Range
CalcCnt = CalcCnt + 1
Set Rng = Nothing
Dict.RemoveAll
For Each Cell In Ws.UsedRange.Cells
If Left(Cell.Formula, 10) = "=myformula" Then
'Debug.Print "From Sht Calc -" & Cell.Address
If Dict.Exists(Cell.Address) = False Then
Dict.Add Cell.Address, Cell.Value
Else
Dict(Cell.Address) = Cell.Value
End If
If Rng Is Nothing Then
Set Rng = Cell
Else
Set Rng = Union(Rng, Cell)
End If
End If
Next
Application.EnableEvents = True
End Sub
In Workbook_Open
Private Sub Workbook_Open()
'Dim X As Integer
Dim Cell As Range
Set Ws = ThisWorkbook.Sheets("Sheet1")
Set Dict = New Dictionary
Flag = True
BuildRange
If Not Rng Is Nothing Then Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
In Sheet Calculate event
Private Sub Worksheet_Calculate()
BuildRange
End Sub
If you are using an UDF in the cell, I will like to make it like this workaround.
For demo and test, Only used a single cell A1 in "Sheet1" , instead of using any API, I used WorksheetFunction.RandomBetween May use range and array if multiple cells are used.
In "Sheet1" cell A1 used =myFormula()
in a module
Public Flag As Boolean, LastVal As Variant
Public Function MyFormula() As Variant
If Flag Then
MyFormula = GetNewValueFromAPI() 'expensive call to server
Else
MyFormula = LastVal
End If
End Function
Function GetNewValueFromAPI() As Variant
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function
Sub CalcA1 in Module1 would be used to recalculate A1 whenever necessary. It could be called from any events also according to actual requirement.
Sub CalcA1()
Flag = True
Worksheets("Sheet1").Range("A1").Dirty
Flag = False
End Sub
In workbook Open event the the LastVal was calculated with Flag as true and then Flag was reset to false to prevent further calling GetNewValueFromAPI
Private Sub Workbook_Open()
Flag = True
Worksheets("Sheet1").Range("A1").Dirty
LastVal = Worksheets("Sheet1").Range("A1").Value
Flag = False
End Sub
In Worksheet_Calculate event of Sheet1 the LastVal is being recorded.
Private Sub Worksheet_Calculate()
LastVal = Worksheets("Sheet1").Range("A1").Value
End Sub
Working Demo
Regret, I came across this post (A Real Good Question) late, since We had already been used something in this line in our workplace. Thanks to #Pawel Czyz for editing the post it came under Active List today only.
I am attempting to update a column (E8:E508) with the contents of another reference column (G8:G508) each time the reference column changes, using the following code:
Private Sub Worksheet_Calculate()
Dim Rng As Range
Set Rng = Range("G8:G503")
If Not Intersect(Rng, Range("G8:G503")) Is Nothing Then
Range("E8:E503") = Range("G8:G503").Value
End If
End Sub
The code works as intended, but appears to be running over and over again and eventually crashes Excel.
Range("E8:E503") = Range("G8:G503").Value
triggers another calculation, which triggers your event handler, etc etc.
To prevent that endless cycle you need to temporarily disable events before doing that (and then re-enable after)
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Range("E8:E503").Value = Range("G8:G503").Value
Application.EnableEvents = True
End Sub
try this
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Rng As Range
Set Rng = Range("G8:G503")
If Not Intersect(Rng, Target) Is Nothing Then
Range("E8:E503") = Rng.Value
End If
Application.EnableEvents = True
End Sub
I am trying to hide a commandbutton based on a specific cell value. I have looked up several codes and pasted them in excel (in the vba form when right clicking the sheet and selecting "view code").
What am I doing wrong?
Here's one of the codes I've tried:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End Sub
Make sure you enable events before using your code. Also, you must place your code in Worksheet module, not in regular module. To enable events, use this simple sub.
Sub Enable_events()
Application.EnableEvents = True
End Sub
please run this first:
Sub enable_()
Application.EnableEvents = True
End Sub
and then your Code will run perfectly:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End Sub
Your code is confusing, for a number of reasons.
Range, when it's not qualified with a Worksheet object, implicitly refers to the ActiveSheet, i.e. ActiveSheet.Range... but when it's in a worksheet's code-behind, it implicitly refers to that worksheet's Range property, i.e. Me.Range. Because the meaning of an unqualified Range call depends on context, it's best to always qualify it with an explicit Worksheet object.
So if you're in the code-behind module for Sheet1, then Range("A1") is equivalent to Sheet1.Range("A1"), or even better, Me.Range("A1").
The two conditions will be evaluated every time, but only one of them needs to be: it's inefficient.
Truth is, you don't need to assign a Boolean literal - a Boolean expression is much cleaner.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.CommandButton1.Visible = (Me.Range("A1") = 1)
End Sub
Now, assuming Application.EnableEvents returns True, that code will run every time the selection changes, which is rather overkill.
Handle the Worksheet.Change event instead, and only act when the modified cell is A1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Me.Range("A1")) Is Nothing And Target.Count <> 1 Then
' we don't care about that cell: bail out
Exit Sub
End If
Me.CommandButton1.Visible = (Me.Range("A1") = 1)
End Sub
Please try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Selection.Cells.Count = 1 Then
If Range("A1") = 0 Then ActiveSheet.CommandButton1.Visible = False
If Range("A1") = 1 Then ActiveSheet.CommandButton1.Visible = True
End If
End If
End Sub
Hope this help.
I've been working on this for some time now and have hit a real stumbling block.
I have a set of values that are available via a validated dropdown menu in Sheet 3, Column D. Once selected this value currently displays in a different sheet (Sheet 7) using excel function ='Sheet 3'!D4 and so on, and I have some code that reads this and performs an IF statement to produce a value in another cell.
My problem is the code is dependant on reading the value and not the formula.
I currently have a worksheet change command for a separate function I want to run, is there a way for this to run a second function and call any changes from sheet 3 column D into sheet 8 column D and then run my other change function?
Sheet 7 Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Range("D2:D102")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finalize
For Each c In Target.Cells
Select Case c.Column
Case 4
Call Print_Quality(c)
End Select
Next c
Finalize:
Application.EnableEvents = True
End Sub
Sheet 7 Module:
Sub Print_Quality(c As Range)
Dim PrintQuality As String
Dim PrintSpeed As String
PrintQuality = c.Value
If PrintQuality = "A Quality 1" Then PrintSpeed = "100"
c.Offset(0, 5).Value = PrintSpeed
End Sub
I've been trying this route but to no avail:
Worksheet 3 code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D4:D104")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finalize
UpdateVal
Finalize:
Application.EnableEvent = True
End Sub
Module:
Sub UpdateVal()
Worksheets("Sheet 7").Range("D2").Value = Worksheets("Sheet 3").Range("D4").Value
End Sub
Many thanks
Sods law, I've managed to fix this an hour after my desperation post.
I completed another worksheet change from the sheet it was calling from (Sheet 3)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("D4:D104")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call UpdateVal
End If
End Sub
then added this function into the module
Sub UpdateVal()
Sheet8.Cells(2, 4).Value = Sheet3.Cells(4, 4)
End Sub
this now references the value of the dropdowns in sheet 8 and allows other functionality to continue using the cell value
Have you tried stepping through your code to see where it is having an issue? It not, I would suggest putting a break at the beginning of each module, and then use F8 to step through. This will confirm it is running as it should.
You should also be fully-qualifying your references to worksheets. While presumably the sheet references should carry through given that they are in worksheet modules, there is the chance of failure. You can simply assign a variable to hold the worksheet like so:
Dim wb as Workbook
Dim ws as Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("YourSheetName")
Additionally, your worksheet 3 code:
EnableEvent = True
Should be:
EnableEvents = True