Filtering multiple pivot tables from a date range in drop down boxes using VBA

[Danners]

Hi all,

I'm hoping someone can help.

I have a dashboard that I must now add to. The entire dashboard is running from a date range in dropdown selections i.e. a from and to date in sheet 1.

I now have set up another sheet with several pivot tables. I need to be able to link these pivot tables to the dropdown selections on sheet 1 and have them filtered based on this option. This is because the end user wants to be able to only make the date selection once and I cant use linked slicers because there are normal graphs and tables as well as pivot tables (I did not create the original dashboard).

I have found numerous bits of vba across the forums and trialled them but none are working for me, and I'm fairly new to VBA so editing the code myself isn't working very well.

The closest I can get to a working code will allow me to filter pivot tables on a text option, but will not allow me to filter on dates which is what I need, and it will also not allow me to select multiple options.

I have posted this below in case it is of use:

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim ws As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim strField As String
 
strField = "Month"
 
On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False
 
    If Target.Address = Range("D2").Address Then
       
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField)
                    For Each pi In .PivotItems
                        If pi.Value = Target.Value Then
                            .CurrentPage = Target.Value
                            Exit For
                        Else
                            .CurrentPage = "(All)"
                        End If
                    Next pi
                End With
            Next pt
        Next ws
   
    End If
 
Application.EnableEvents = True
Application.ScreenUpdating = True
 
End Sub

Hopefully this makes sense. Any help that can be provided would be much appreciated.

Thanks
Danielle