VBA Pivot Table One Cell Reference Different Sheet - vba

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

Related

Run Worksheet_Change if multiple defined cells are changes

I have the following code that runs a goalseek if the defined named range "N" changes. However, I want the code to run if any of several cells changes. E.g. "N1", "N2", etc..
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Address = Range("N").Address Then
'Goalseek for force equilibrium
Range("Delta_F").GoalSeek Goal:=0, ChangingCell:=Range("h_neutral")
End If
Application.EnableEvents = True
End Sub
I tried the following, but it did not work:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Address = Range("N, N1, N2").Address Then
'Goalseek for force equilibrium
Range("Delta_F").GoalSeek Goal:=0, ChangingCell:=Range("h_neutral")
End If
Application.EnableEvents = True
End Sub
Any help is appreciated. Thanks in advance.
Testing your criteria as a Range is easier than testing the Address as a string.
Building on #Michal's solution, the below will only execute when your changed cell (Target) overlaps (Intersects) with your 3 ranges (Set as the variable TargetRange here). The main difference is the double negative in the test statement which allows you to avoid Exit Sub resulting in moderately cleaner code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetRange As Range
Set TargetRange = Union(Range("B3"), Range("G19"), Range("N1"))
If Not Intersect(TargetRange, Target) Is Nothing Then
Application.EnableEvents = False
Range("Delta_F").GoalSeek Goal:=0, ChangingCell:=Range("h_neutral")
Application.EnableEvents = True
End If
End Sub
Your condition can be easily checked with Intersect function:
If Intersect(Range("N"), Target) Is Nothing Then Exit Sub
If Target doesn't lie within your range, it will exit the sub (this condition should be placed as the first command in your Sub).

Run a macro automatically every minutes

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

VBA recognizing more than one cell is highlighted

I have the following VBA script:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("calendar")) Is Nothing Then
[selectedCell1] = ActiveCell.Value
Application.ScreenUpdating = True
End If
End Sub
Currently, It recognizes only one cell is highlighted and returns it into the specific cell named selectedCell1.
This is my example:
If I select the cell N25 which contains the date "03/08/2017" it returns "03/08/2017" into another sheet cell named "selectedCell1".
But what I would like it to do, is realize I've selected the entire week, and then return that entire week range in cell "selectedCell1". See:
And then return 01/08/2017 - 05/08/2017 (that entire range) in cell "selecetedCell1".
Not sure how to adjust this VBA script. Help would be appreciated. Thanks.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("calendar")) Is Nothing Then
If Target.Cells.Count = 1 Then
[selectedCell1] = Target.Value
Else
[selectedCell1] = Format(Application.WorksheetFunction.Min(Target), "dd/mm/yyyy") & " - " & Format(Application.WorksheetFunction.Max(Target), "dd/mm/yyyy")
End If
Application.ScreenUpdating = True
End Sub

Stop NOW() Function from Auto Updating

I have a cell which I want to record the time when adjacent cells to the left are changed. I do it with the NOW() function; however, the problem is that the time gets updated each time workbook is re-calculated. So, I am wondering whether there is any original way to prevent this very cell from auto-updating.
My current formula in the cell:
=IF(ISBLANK(H11),"",IF(H11="Interested",NOW(),IF(H11="Not Interested",NOW(),"")))
I personally have come up with this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Destination As Range
If Not Intersect(Target, Range("H:H")) Is Nothing Then
Target.Offset(0, 1).Value = Now
End If
End Sub
My issue with this code is that it is looking for any data in the cell. I am only wanting the cell to record the time when it contains either "Interested" or "Not Interested". The cell that I am looking at currently contains "In-progress". I have tried playing around with my code to try and incorporate these criteria's but I keep getting hit with errors. Any advice on what I can do to fix this? Thanks in advance.
Try the following code instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Destination As Range
If Not Intersect(Target, Range("H:H")) Is Nothing Then
If LCase(Trim(Target.Value2)) = "not interested" Or LCase(Trim(Target.Value)) = "interested" Then
Application.EnableEvents = False
Target.Offset(0, 1).Value = Now
Application.EnableEvents = True
End If
End If
End Sub
An alternative approach is a simple UDF that you use as =TimeChanged(H11)
Option Explicit
Option Compare Text
Public Function TimeChanged(theCell As Variant)
If TypeOf theCell Is Range Then theCell = theCell.Value2
If theCell = "Interested" Or theCell = "Not Interested" Then
TimeChanged = Now
Else
TimeChanged = ""
End If
End Function

Can't change value of cell with code in a protected sheet

I have a password protected sheet, with some unlocked cells that user can chage.
Once the user changes any value, it automatically should make changes to other unlocked cells by vba code. This works fine if the sheet is unlocked, but not if it's protected.
example of code:
In Workbook_Open() I set UserInterfaceOnly attribute to TRUE:
Sheets("Sheet Name").Protect Password:="123456", UserInterFaceOnly:=True, Contents:=True
Sheet code: Set date.01 value into date.02 cell if date.01 changes
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Worksheets("Sheet Name").Range("date.02") = Target
End If
End Sub
cells "date.01" and "date.02" are unlocked.
Why can't I update them?
EDIT:
Is SelectionChange event the best option to change cell values? And is it ok to do the assignment like this:
Worksheets("Sheet Name").Range("date.02") = Target
I can see that the changes are applieD when the original cell get the focus back.
What I really want to do is to give a group of cells in different sheets the same value anytime any of them are changed by the user.
SOLVED.
My bad, I was using
Worksheet_SelectionChange
instead of
Worksheet_Change
I also had to use this to prevent any errors.
Application.EnableEvents = False
<CODE>
Application.EnableEvents = True
There was no need of using UserInterfaceOnly as all cells/ranges are unlocked.
you can simply check it's something to do with protection.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Sheets("Sheet Name").unProtect Password:="123456"
`Worksheets("Sheet Name").Range("date.02") = Target`
`Sheets("Sheet Name").Protect Password:="123456", UserInterFaceOnly:=True`
End if
End Sub
Do you apply validation through VBA
The event method to use is Worksheet.Change Event
https://msdn.microsoft.com/en-us/library/office/ff839775.aspx
And the code was like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("date.01")) Is Nothing Then
Application.EnableEvents = False
Worksheets("Sheet1").Range("date.01") = Target
Worksheets("Sheet2").Range("date.02") = Target
Worksheets("Sheet3").Range("date.03") = Target
Worksheets("Sheet4").Range("date.04") = Target
Worksheets("Sheet5").Range("date.05") = Target
Application.EnableEvents = True
End If
End Sub