Visual Basic Code Stopped Working

S

squeakums

Well-known Member
Joined
May 15, 2007
Messages
839
Office Version
  1. 365
I have this code below to where I select a name in cell I4, and then click run in cell f4, and this filters to that name in each pivot table on the page. This always worked before but all of a sudden stopped working?

Also, is there a way I can write this to where if you just select another name in cell I4, that it automatically updates the pivot tables instead of having to push it to run with another cell?



Code: 
Private Sub Worksheet_PivotTableAfterValueChange(ByVal TargetPivotTable As PivotTable, ByVal TargetRange As Range)
'This line stops the worksheet updating on every change, it only updates when cells are touched
If Intersect(Target, Range("I4")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String

'Here you amend to suit your data.  Assigns input cell value to the PT on another tab.
Set pt = Worksheets("MOEVM Summary Level").PivotTables("VLQP")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With


Set pt = Worksheets("MOEVM Summary Level").PivotTables("DeliverablesDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
End With



Set pt = Worksheets("MOEVM Summary Level").PivotTables("Issues")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With




Set pt = Worksheets("MOEVM Summary Level").PivotTables("upcomingdeliverables")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With



Set pt = Worksheets("MOEVM Summary Level").PivotTables("upcomingvlqp")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

Set pt = Worksheets("MOEVM Summary Level").PivotTables("DeliverPastDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

Set pt = Worksheets("MOEVM Summary Level").PivotTables("VLQPPastDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

Set pt = Worksheets("MOEVM Summary Level").PivotTables("Issues")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

Set pt = Worksheets("MOEVM Summary Level").PivotTables("IssuesPastDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

End Sub

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, it only updates when cells are touched
If Intersect(Target, Range("I4")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String

'Here you amend to suit your data.  Assigns input cell value to the PT on another tab.
Set pt = Worksheets("MOEVM Summary Level").PivotTables("VLQP")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With


Set pt = Worksheets("MOEVM Summary Level").PivotTables("DeliverablesDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
End With



Set pt = Worksheets("MOEVM Summary Level").PivotTables("Issues")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With




Set pt = Worksheets("MOEVM Summary Level").PivotTables("upcomingdeliverables")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With



Set pt = Worksheets("MOEVM Summary Level").PivotTables("upcomingvlqp")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

Set pt = Worksheets("MOEVM Summary Level").PivotTables("DeliverPastDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

Set pt = Worksheets("MOEVM Summary Level").PivotTables("VLQPPastDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With


Set pt = Worksheets("MOEVM Summary Level").PivotTables("Issues")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With


Set pt = Worksheets("MOEVM Summary Level").PivotTables("IssuesPastDue")
Set Field = pt.PivotFields("MOEVM")
NewCat = Worksheets("MOEVM Summary Level").Range("F4").Value

'This updates and refreshes the PIVOT table
With Field
    .ClearAllFilters
    On Error Resume Next
    .CurrentPage = NewCat
    
End With

End Sub
 
Last edited by a moderator:

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
You must log in or register to reply here.

Similar threads

D
  • Question Question
VBA code to filter out blank values in a pivot table
Replies
2
Views
584
dragontbone
D
H
  • Solved
Macro to clear Data in ColE one row below "Grand Total"
Replies
1
Views
258
howard
H
N
  • Solved
VBA Update Pivot when cell value changes
Replies
3
Views
2K
NormChart55
N
M
  • Question Question
VBA Macro with option to filter Pivot Tables multiple times.
Replies
0
Views
706
Macro_nerd
M
T
  • Question Question
Clear FIlters of Pivot Table after Cell Value Changes
Replies
4
Views
438
Alex Blakenburg
A

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top