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
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´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.
I have 4 Cells (S11:T12) and a Command Button 1, what I want is, until all 4 cells are populated the command button should be disabled (Which I can do from the properties tab) and once all 4 cells are filled with number, the command button should be enabled and once the data from these cells are deleted, the command button should be disabled again.
Under which event should I write the code?
I tried this, but it does not work.
Private Sub Workbook_Open(Cancel As Boolean)
If Sheets("WorkArea").Range("S11:T12") = "" Then
Sheets("WorkArea").CommandButton1.Enabled = False
Else
Sheets("WorkArea").CommandButton1.Enabled = True
End If
End Sub
Use the WorkSheet_Change event handler to handle the change in cells, and you can use the CountBlank worksheet function to determine if a range is empty.
Private Sub Worksheet_Change(ByVal Target As Range)
If WorksheetFunction.CountBlank(Range("S11:T12")) = 4 Then
Sheets("WorkArea").CommandButton1.Enabled = False
Else
Sheets("WorkArea").CommandButton1.Enabled = True
End If
End Sub
Worksheet_Change
CountBlank
According to your question however, you actually want:
Private Sub Worksheet_Change(ByVal Target As Range)
If WorksheetFunction.CountBlank(Range("S11:T12")) = 0 Then
Sheets("WorkArea").CommandButton1.Enabled = True
Else
Sheets("WorkArea").CommandButton1.Enabled = False
End If
End Sub
A Worksheet Change
This solution will not work if the critical range contains formulas.
To count the number of cells that are not empty you can use the WorksheetFunction.CountA method.
Usually you don't want this code to run when there are changes outside of the range, so you will restrict the code to the range with the Application.Intersect method. You don't have to enable or disable the command button on each change since obviously the code will run on each change.
Since this is all happening in worksheet "WorkArea", there is no need to refer to it by its name i.e. you can safely use Range(rngAddress) and CommandButton1 instead of ThisWorkbook.Worksheets("WorkArea").Range(rngAddress) and ThisWorkbook.Worksheets("WorkArea").CommandButton1 respectively.
The Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const rngAddress As String = "S11:T12"
Dim rng As Range
Set rng = Range(rngAddress)
If Not Intersect(Target, rng) Is Nothing Then
If WorksheetFunction.CountA(rng) = rng.Cells.Count Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
End If
End Sub
Problem: need to be able to check a range or a single cell to see if blank.
My code to replace any text with a check mark looks like this:
Private Sub Worksheet_Change(ByVal Target As Range)
' If the range (as defined in the next line) is changed to anything but a blank, replace it with a check mark.
If Not Intersect(Range(Target.Address), Range("C6:C60")) Is Nothing Then
On Error GoTo ErrorOut
Application.EnableEvents = False
If Application.WorksheetFunction.IsText(Range(Target.Address)) Then
Range(Target.Address).Value = "P"
Range(Target.Address).Font.Name = "Wingdings 2"
End If
Application.EnableEvents = True
End If
Exit Sub
ErrorOut:
Debug.Print "Error"
Application.EnableEvents = True
End Sub
It works. But, if the user selects more than one cell and deletes them the error handling takes over. Not a problem, because it works, but there has to be a better way.
I've been successful doing this when I wanted to check for numbers by using If IsNumeric(Range(Target.Address)) Then. It works correctly if a bunch of cells are deleted at once. But IsText or IsEmpty doesn't seem to behave exactly like IsNumeric and deleting a bunch of cells at once generates an error.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range, rIntersect As Range
Dim wf As WorksheetFunction
Set rng = Range("C6:C60")
Set rIntersect = Intersect(Target, rng)
Set wf = Application.WorksheetFunction
If rIntersect Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In rIntersect
If wf.CountA(r) = 1 Then
r.Value = "p"
r.Font.Name = "Wingdings 2"
End If
Next r
Application.EnableEvents = True
End Sub
We loop over the Intersection one cell at a time. By the way, I use:
r.Value = "a"
r.Font.Name = "Marlett"
I have the following question:
The code you see below has been pasted in an excel object
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Dim DAY, other As Range
Set DAY = Range("b4:af4")
If Not Intersect(DAY, Range(Target.Address)) Is Nothing Then
ActiveCell.Copy
Sheets("SP Analysis").Activate
Range("b2").PasteSpecial Paste:=xlPasteValues
'ElseIf Not Intersect(other, Range(Target.Address)) Is Nothing Then
End If
End Sub
The macro runs but it doesn't copy the activecell in the sheet SP Analysis.
If I change the code with the following:
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Dim DAY, other As Range Set DAY = Range("b4:af4")
If Not Intersect(DAY, Range(Target.Address)) Is Nothing Then Call TEST
'ElseIf Not Intersect(other, Range(Target.Address)) Is Nothing Then End If End Sub
with macro TEST doing
sub test
ActiveCell.Copy
Sheets("SP Analysis").Activate
Range("b2").PasteSpecial Paste:=xlPasteValues
end sub
The command does what is supposed to do.
Question is why? what's the difference between one method and the other?
And, how can I have the command working in an excel object rather than having to call a macro?
Thank you
Try this. Use Target rather than ActiveCell although in this case I don't know why the latter wouldn't work. And we can transfer the value directly without having to activate anything.
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Dim DAY As Range, other As Range 'need to specify type for each variable, otherwise Variant
Set DAY = Range("b4:af4")
If Not Intersect(DAY, Target) Is Nothing Then
Cancel=True
Sheets("SP Analysis").Range("b2").Value = Target.Value 'use target
End If
Application.ScreenUpdating = True 'turn it back on
End Sub