I am having trouble finding a way to capture any changes within a specific worksheet, within a specific pivot table.
The Pivot is "pivottable6"
The Worksheet is "APAC"
I have placed this code within the APAC worksheet module:
Private Sub Worksheet_PivotTableChange(ByVal Target As Excel.PivotTable6)
With Target
MsgBox "You performed an operation in the following PivotTable: " & .Name & " on " & Sh.Name
End With
End Sub
But I keep getting an error. Any ideas on how to fix it?
Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Target, Target As PivotTable)
If Intersect(Target, ActiveSheet.PivotTables(1)) Is Nothing Then Exit Sub
MsgBox ("cat")
End If
End Sub
this is still coming up with USER TYPE NOT DEFINED ERROR
Do you want to refresh the pivot when data in sheet changes ? If yes try below code :
Kindly place this code on the sheet which has the pivot.
Private Sub Worksheet_Calculate()
Sheets("APAC").PivotTables("pivottable6").RefreshTable
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
With Target
MsgBox "You performed an operation in the following PivotTable: " & .Address & " on """ & Target.Parent.Name & """Sheet"
End With
Application.EnableEvents = True
End Sub
Your code makes use of Sh.Name, but Sh is not defined. Use Me.Name instead.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
With Target
MsgBox "You performed an operation in the following PivotTable: " & .Name & " on " & Me.Name
End With
End Sub
In answer to your other question, you need to change the IF statement to something like this:
Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Target, Target As PivotTable)
If Intersect(Target, ActiveSheet.PivotTables(1)) Is Nothing Then
Exit Sub
Else
MsgBox ("cat")
End If
End Sub
Related
The following code successfully changes the sheet name based on the value in cell "E26" i.e. if the value in "E26" is 'Test', sheet name will be named 'Test'.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Target = Range("E26")
If Target = "" Then Exit Sub
Application.ActiveSheet.Name = VBA.Left(Target, 31)
Exit Sub
End Sub
Problem is, if I copy the sheet but want to keep the value in cell "E26" the same, the copied sheet name becomes "Test (1)" but I get a Run time error '1004': That name is already taken. Try a different one. obviously.
Question: How can I automatically add a number after each subsequent copy of the sheet i.e. Test (1), Test (2), etc. to avoid getting the error while still keeping the value in cell "E26" the same i.e. Test?
I don't know if I understood the idea, but try to count the current sheets in your book and concat to the name you want
Private Sub Worksheet_SelectionChange(ByVal Target As Range)`
Set Target = Range("E26")
Dim nSheets As Double
nSheets = ThisWorkbook.Sheets.Count
If Target = "" Then Exit Sub
'+1 is optional in order you have a secuence
Application.ActiveSheet.Name = Target & "(" & nSheets + 1 & ")"
End Sub
Let me suggest a bit more complex solution that hopefully also addesses all sort of end cases.
First, let's create a helper function that can answer the question "Is there a sheet with the name x?".
Function sheetExists(name) As Boolean
sheetExists = False
For i = 1 To Application.Worksheets.Count
shtName = Application.Worksheets(i).name
If shtName = name Then
sheetExists = True
Exit Function
End If
Next
End Function
Now that we have that option, let's build the actual code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MaxTabs = 10 ' Adjust this number as needed.
BaseName = Range("E26").Value
If (BaseName = "") Then
Exit Sub
End If
name = BaseName
i = 0
For i = 1 To MaxTabs
If (Not sheetExists(name)) Then
Application.ActiveSheet.name = name
Exit Sub
End If
name = BaseName + " (" + Trim(Str(i)) + ")"
Next
End Sub
Worksheet Change
You could rather use the Worksheet_Change event and suppress the error(s) by using On Error.
The Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range: Set rg = Intersect(Range("E26"), Target)
If Not rg Is Nothing Then
Application.EnableEvents = False
On Error GoTo clearError
Me.Name = Left(rg.Value, 31)
Application.EnableEvents = True
End If
Exit Sub
clearError:
'Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume Next
End Sub
This is my first time using a drop down list. I was wondering if there was a way to assign a macro to each of the items in the drop down list.
For an example if I selected BZ1A I would want it to run the sub I have called BZ1A.
Run Macros From Drop Down
Copy the first code into the sheet module of the worksheet containing the drop down, e.g. Sheet1 (the name in parentheses in the VBE Project Explorer).
Adjust the values in the constants section.
Put your codes into the same module, e.g. Module1. Otherwise you will have to modify the code.
In this example the drop down list is in cell A1 of worksheet Sheet1 and contains the list (values) Sub1, Sub2, Sub3.
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const CellAddress As String = "A1"
Const ModuleName As String = "Module1"
If Target.Cells.CountLarge = 1 Then
If Not Intersect(Range(CellAddress), Target) Is Nothing Then
Application.EnableEvents = False
On Error GoTo clearError
Application.Run ModuleName & "." & Target.Value
Application.EnableEvents = True
End If
End If
Exit Sub
clearError:
MsgBox "Run-time error '" & Err.Number & "': " & Err.Description
Resume Next
End Sub
Standard Module e.g. Module1 (Example)
Option Explicit
Sub Sub1()
MsgBox "Running 'Sub1'"
End Sub
Sub Sub2()
MsgBox "Running 'Sub2'"
End Sub
Sub Sub3()
MsgBox "Running 'Sub3'"
End Sub
I have a worksheet function that automatically calls CopyValues once dropdown in E4 changes on Sheet Debt Detail. This macro only runs if the sheet name is "Debt Detail" otherwise it is going to Exit Sub. This macro worked well until now. I added another sheet called "Borrower Statement", which is supposed to call BorrowerStatementCall if E4 changes in Sheet Borrower Statement.
I need to modify the existing Workbook function to accomplish this.
Below is the existing code. Any help and suggestions on how to accomplish this would be appreciated:
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
If sh.Name <> "Debt Detail" Then Exit Sub
If Target.Address = Range("$E$4").Address Then
Call CopyValues
Range("A1").ClearOutline
Range("d2").Select
End If
Application.ScreenUpdating = True
End Sub
Some suggestions on your code:
Indent your code
Use at least some error handling if you're turning off screenupdating and other stuff
No need for the Call statement
Code:
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
On Error GoTo CleanFail
' Exit if modified cell is not E4
If Target.Address <> "$E$4" Then Exit Sub
' Turn off stuff to speed up process (only if modified cell is E4)
Application.ScreenUpdating = False
' Check the sheet name and call procedure accordingly
Select Case sh.Name
Case "Debt Detail"
' Do stuff if it's the target sheet
CopyValues ' Calls the sub CopyValues
sh.Range("A1").ClearOutline
sh.Range("D2").Select
Case "Borrower Statement"
' Do stuff if it's the target sheet
BorrowerStatementCall ' calls the sub BorrowerStatementCall
End Select
CleanExit:
' Turn on stuff again
Application.ScreenUpdating = True
Exit Sub
CleanFail:
MsgBox "An error occurred:" & Err.Description
GoTo CleanExit
End Sub
Let me know if it works
I have problem with ClearContents in Worksheet_Change as it keep ClearContents of the range and doesn't allow me for data entry. i want ClearContents to done only one time
would you help me with that
the code I use below
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Range("A6") = "Semi Auto" Then
Range("E5:L5").ClearContents
Range("E6:L6").Formula = Range("E14:L14").Formula
End If
Application.EnableEvents = True
End Sub
This one will only trigger, if the change is concerning Range("A6"):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A6")) Is Nothing Then Exit Sub
If Range("A6") = "Semi Auto" Then
Range("E5:L5").ClearContents
End If
End Sub
A Worksheet Change
When you copy the code into the sheet module, the second solution will be 'active'. It is the Play solution, which you should use to explore how the Worksheet Change event behaves.
When done testing, delete it or rename it, and then rename the first, the Real solution, to Worksheet_Change without the 1.
This will only work if you're manually changing the values in A6, which also includes the change via dropdown or VBA code. If you have a formula in A6 this will not work.
The Code
Option Explicit
Private Sub Worksheet_Change1(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Not IsError(Range("A6")) Then
If Range("A6") = "Semi Auto" Then
Application.EnableEvents = False
On Error GoTo SafeExit
Range("E5:L5").ClearContents
Range("E6:L6").Formula = Range("E14:L14").Formula
On Error GoTo 0
Application.EnableEvents = True
End If
End If
End If
ProcExit:
Exit Sub
SafeExit:
Application.EnableEvents = True
GoTo ProcExit
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Not IsError(Range("A6")) Then
If Range("A6") = "Semi Auto" Then
MsgBox "Semi Auto."
Else
MsgBox "Not Semi Auto."
End If
Else
MsgBox "Is error value."
End If
Else
MsgBox "Not cell ""A6""."
End If
End Sub
I retrieved a helpful VBA command from the internet which allows me to change an arbitrary cell in Excel which acts as a filter for my pivot table. When I try to reuse this same command on the same sheet but for a different filter, I get a "Compile Error: ambiguous name detected: Worksheet_Change" notification and the code stops working... I tried to change "End Sub" to "Exit Sub" which did not work, and I am hoping someone can point me in the right direction here.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Address = Range("D2").Address Then Exit Sub
Dim PT As PivotTable
Dim ptItem As PivotItem
On Error Resume Next
For Each PT In Worksheets("Tier Comps").PivotTables
With PT.PivotFields("Product")
If .EnableMultiplePageItems = True Then
.ClearAllFilters
End If
Set ptItem = .PivotItems(Target.Value)
If Not ptItem Is Nothing Then
.CurrentPage = Target.Value
End If
End With
Next
Exit Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Address = Range("D3").Address Then Exit Sub
Dim PT As PivotTable
Dim ptItem As PivotItem
On Error Resume Next
For Each PT In Worksheets("Tier Comps").PivotTables
With PT.PivotFields("Country Tier")
If .EnableMultiplePageItems = True Then
.ClearAllFilters
End If
Set ptItem = .PivotItems(Target.Value)
If Not ptItem Is Nothing Then
.CurrentPage = Target.Value
End If
End With
Next
End Sub
Hoping to have two separate cells modify two separate filters for one pivot table on the same sheet.
Please take a full read through --> https://stackoverflow.com/help/minimal-reproducible-example
One of the best parts about working through the process of making an MCVE is a lot of the time during the process of writing the question you will solve it yourself as you strip out more code to find the issue.
Here is a simplified answer, modify the MsgBox portion with your actual code.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2")) Is Nothing Then
MsgBox "Cell D2 Change Event"
End If
If Not Intersect(Target, Range("D3")) Is Nothing Then
MsgBox "Cell D3 Change Event"
End If
Exit Sub
Also, just for completeness sake. The issue is you can't have two subs with the same name. Another issue to look out for that I ran into is don't name Modules the same name as the sub. I usually add an _. Eg Module = Test_Sub and then Private Sub TestSub()