Good morning
Basically I am importing index data from the web (abcbourse.com) and I make it refresh every minutes.
I created a macro in order to recorder historical values of each index (starting with the CAC40 as you can see in the screenshot, with new values going on column E every minute (each time the data is automatically refreshed)
Here is my macro, working well (see Column E of the screenshot):
Sub Historical_Index()
Dim LastLRow As Integer, CurrentIndexValue As Single
LastRow = Range("E" & Rows.Count).End(xlUp).Row
CurrentIndexValue = Range("B1")
Do
If Not IsEmpty(CurrentIndexValue) = True Then
Cells(LastRow + 1, 5).Value = CurrentIndexValue
Exit Do
End If
Loop
End Sub
My problem is, I want this macro to run every time the data is refreshed. I initially used a
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Application.EnableEvents = False
Call Historical_Index
Application.EnableEvents = True
End If
End Sub
And this is indeed calling my macro but only if I change B2 manually. If I wait for the data to be refreshed automatically my macro is not called (even though the data has changed).
I would like to know what to do in order to automate this process, I need your help.
Thanks in advance
Ps: I don’t know if it matters, but my macro is saved in VBAProject(“this document”) > Sheet2 (Sheet2)
Please try the below for the range B1:B8:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.Range("B1:B8")) Is Nothing Then
Application.EnableEvents = False
Call Historical_Index
Application.EnableEvents = True
End If
End Sub
or if you want to check only B2:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.Range("B2")) Is Nothing Then
Application.EnableEvents = False
Call Historical_Index
Application.EnableEvents = True
End If
End Sub
Related
This question already has answers here:
Why MS Excel crashes and closes during Worksheet_Change Sub procedure?
(3 answers)
Closed 4 years ago.
I have reworked this macro for two days in a load of different ways to try to prevent steps from repeating but the range G2 step seems to run 3 or 4 times and the range G3 2 or 3 times. Does anyone have any ideas??
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Exit Sub
End If
End Sub
Your Worksheet_Change has succumbed to three of the most common mistakes in an event driven worksheet/workbook sub procedure.
You are not disabling events while making modifications to the worksheet. Each change triggers another event and the Worksheet_Change tries to run on top of itself over and over until it crashes.
Target could be a single cell or many cells. You need to deal with the possibility of Target being many cells by using Intersect to only get the affected cells within your range of possibilities.
If you disable events for any reason, make sure to provide error control that turns them back on if everything goes south. Typically, this can be done just before exiting the Worksheet_Change but not if you are going to use Exit Sub.
Here is my version of your procedure.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4, G2:G4")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("D4, G2:G4"))
Select Case trgt.Address(0, 0)
Case "G2"
Range("G3:G4") = Application.Transpose(Array("Division", "Team"))
'call check is below
Case "G3"
Range("G4") = "Team"
'call check is below
Case "D4", "G4"
'call check is below
End Select
Next trgt
Call check
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Your code is in the Worksheet_Change event. Every time the worksheet is changed this event fires, including when your code changes it
Range("g4").Value = "Team"
Thus you're stuck in a potentially infinite loop. To avoid this disable events before making any changes
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' this turns events off
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End Sub
You might need to enable or disable events within the subs you're calling too.
BTW I'd check if you really need those Exit Subs, if not you can just disable events once at the start and re-enable again at the end.
I'm using this current code to update a pivot table filter based on a cell value (E1) within the same sheet. What i would like to do is to update a filter based on a cell in a sheet named summary. If I set the filed in the current filed equal to the cell in the summary I need to press f2 and enter otherwise it won't work. I'm sure a little bit of tweaking and my code could work for it.
Any tips?
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Range("E1")
If Target Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Sheets("Tech Pivot Table").PivotTables("PivotTable2").PivotCache.Refresh
With Me.PivotTables("PivotTable2")
.PivotCache.Refresh
.PivotFields("Name").CurrentPage = Target.Value
End With
Application.EnableEvents = True
End Sub
I think the problem is you're changing the value the Target variable up front when you should be checking to see if Target = "E1". Try the code below and let me know if it works.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("E1") Then
If Target Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Sheets("Tech Pivot Table").PivotTables("PivotTable2").PivotCache.Refresh
With Me.PivotTables("PivotTable2")
.PivotCache.Refresh
.PivotFields("Name").CurrentPage = Target.Value
End With
Application.EnableEvents = True
End If
End Sub
I have a macro that puts the current time into a cell upon editing any row. my problem is that this macro also executes for row 1 which are the titles. So it ends up changing the title of a column to a time.
The macro works fine but still changes the title. I tried the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If ActiveCell.Row = 1 Then Exit Sub
Cells(Target.Row, "I").Value = Now
Application.EnableEvents = True
End Sub
The ActiveCell can change to something else after you edit, so use the Target range rather than the ActiveCell. For example, if I hit {enter} to finish my edit, the ActiveCell is now on row 2 rather than 1.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Row > 1 Then
Cells(.Row, "I").Value = Now
End If
End With
Application.EnableEvents = True
End Sub
I'm using With syntax to show the same Row you are comparing is the one you are editing. You could still put these on separate lines if you wish.
Also, user Jeeped makes a good point about the Application.EnableEvents = True line. It won't run if the row is 1, so they get turned off indefinitely. Better to test for > 1 and only run your update code on that condition.
If you turn off event handling, provide error control that makes sure that events will be re-enabled.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim r As Long, rw As Long, rng As Range, newTarget As Range
For Each rng In Target
If rng.Column <> 9 Then
If newTarget Is Nothing Then
Set newTarget = rng
Else
Set newTarget = Union(newTarget, rng)
End If
End If
Next rng
For r = 1 To newTarget.Rows.Count
rw = newTarget.Rows(r).Row
If rw > 1 Then _
Cells(rw, "I").Value = Now
Next r
Safe_Exit:
Application.EnableEvents = True
End Sub
If you are pasting or filling a large number of values then Target is all of the cells that changed. You need to guard against the top row while everything else receives the timestamp. When Target is more than a single cell, you only want to timestamp once per row.
And you don't want to turn off event handling then exit without turning it back on again.
I'm working on an excel sheet wherein each row needs to indicate the last time that any cell within that row has changed. The simplest method I've found to do this is to put some tiny amount of VBA in the worksheet code, like so:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Row > 2) And (Cells(Target.Row, "A") <> "") Then
Cells(Target.Row, "N").Value = Date
End If
Application.EnableEvents = True
End Sub
This will effectively change the date in the "N" column whenever any other item in that row is edited. Great! Solved, except...
Because I'm changing the cell value in the code, the undo stack is immediately lost, and of course this means that ANY work in this worksheet cannot be undone.
So, an alternative to this is to trick excel into thinking I haven't edited a cell. This code preserves the undo stack while changing the date:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cursorLocation As Range
Application.EnableEvents = False
If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
Set cursorLocation = ActiveCell
Cells(Target.Row, "N").Select
SendKeys "^;~", True
cursorLocation.Select
End If
Application.EnableEvents = True
End Sub
In this case, we select the cell, use SendKeys to fake editing the cell, and the restore the cursor to its original location. "^;~" is using Excel's "Ctrl+;" shortcut to input the date. Great! Solved, except...
This code works fine on my machine (Win7, Excel 2010) but fails on a co-worker's machine (Win8, Excel 2010, maybe a bit faster). On the Win8 machine (no idea if it's the OS that's the problem, btw), what happens is that whenever a cell is changed, every cell immediately below that cell becomes the current date, and of course preserving the Undo history is meaningless because executing an Undo immediately reactivates the worksheet code and turns everything into dates again.
I figured out on my own that the same thing will happen on my machine if I remove the "Wait" inherent in the SendKeys command. That is, if I use the line:
SendKeys "^;~", False
So, what I'm guessing is that for whatever reason, even when using the same version of Excel, my computer is waiting for the SendKeys command to finish, but my co-worker's computer is not. Any ideas?
You are right. It gives that problem in Excel 2010/Win8.
Try this. Use the custom Wait code that I wrote. (Tested in Excel 2010/Win8)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cursorLocation As Range
Application.EnableEvents = False
If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
Set cursorLocation = ActiveCell
Cells(Target.Row, "N").Select
SendKeys "^;~"
Wait 1 '<~~ Wait for 1 Second
cursorLocation.Select
End If
Application.EnableEvents = True
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Alternative
Using Doevents also has the desired effect.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cursorLocation As Range
Application.EnableEvents = False
If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
Set cursorLocation = ActiveCell
Cells(Target.Row, "N").Select
SendKeys "^;~"
DoEvents
cursorLocation.Select
End If
Application.EnableEvents = True
End Sub
I have an Excel like shown below which is a sharedExcel.
Now i should not allow paste option for the rows which have backcolour as GRAY(These are not fixed at runtime any row may get GRAY colour). As it sharedExcel and i can't use the Lock property. Any help wouls be appreciated greatly.
Using a color as a property that is used to check true / false is bad behaviour.
You can get around this by for example adding a column (hidden if needed) with 0 / 1 or TRUE / FALSE which you make accessible by for example a combobox (then you can still adapt the color into gray by clicking this cbb box).
The you can check on a dynamically composed range via a Sheet event on_Change.
The basic syntax for the sheet event:
Private Sub Worksheet_Change(ByVal Target As Range)
'Set range dynamically instead of this hard coded example
If Not Intersect(Target, Thisworkbook.Sheets(1).Range("A1:A10")) Is Nothing Then
'Do something
End If
End Sub
After spending some time on this problem i have coded following lines. It work's fine. Here i have taken another spreadsheet called PasteSheet for coding purpose but i am not showing it to user at any moment.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode Then
SelectedRow = ActiveCell.Row
With Sheets("PasteSheet")
.Activate
.Range("A1").PasteSpecial xlPasteValues
CR = Selection.Rows.Count
End With
Worksheets("ActualSheet").Activate
For k = SelectedRow To (SelectedRow + CR)
If Worksheets("ActualSheet").Cells(k, 30).Interior.Color = RGB(215, 215, 215) Then
Application.EnableEvents = False
MsgBox "Pasting is not allowed here!"
'Clearing data in PasteSheet
Worksheets("PasteSheet").Cells.ClearContents
Worksheets("ActualSheet").Activate
Application.EnableEvents = True
Exit Sub
End If
Next
End If
End Sub