Visual Basic Code Stopped Working

S

squeakums

Well-known Member
Joined
May 15, 2007
Messages
851
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 automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
You must log in or register to reply here.

Similar threads

ghull99
  • Question Question
Attempting VBA to refresh "Chart Title" based on Pivot Filters. Filter1 works in VBA, but title doesn't update based on filter2.
Replies
0
Views
73
ghull99
ghull99
D
  • Question Question
VBA code to filter out blank values in a pivot table
Replies
2
Views
734
dragontbone
D
J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
273
Jette3173
J
H
  • Solved
Macro to clear Data in ColE one row below "Grand Total"
Replies
1
Views
262
howard
H
N
  • Solved
VBA Update Pivot when cell value changes
Replies
3
Views
2K
NormChart55
N

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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