Aggiornamento tabelle pivot vba

[Marco Porzio]

ciao,
ho inserito in una cella un menu a tendina tramite Convalida dati.
alla selezione del dato della tendina eseguo il codice sottostante che va ad eseguire il filtro su una tabella pivot e tutto funziona benissimo!

devo però fare la stessa cosa in un altra cella sempre nello stesso foglio che mi deve aggiornare una seconda tabella pivot ma non c'è verso di farla funzionare cioè non imposta il filtro e non aggiorna la pivot

ho replicato il codice qui sotto basato su Target, Cells(4, 3) ma non va...
come faccio ad eseguire 2 volte questo codice su celle e pivot diverse?
grazie
Marco


Private Sub Worksheet_Change(ByVal Target As Range)

Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String

On Error Resume Next

If Not Application.Intersect(Target, Cells(4, 1)) Is Nothing Then

Application.ScreenUpdating = False

Range("C4") = ""
Range("I4") = ""
Set xPTable = Worksheets(ActiveSheet.Name).PivotTables("tp_CodFam")
Set xPFile = xPTable.PivotFields("PROD_TYPE")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If IsEmpty(ActiveSheet.Range("A4")) Then ActiveSheet.Range("C4", "F4", "I4").Value = ""

End If

End Sub

[Bruno Campanini]

Marco Porzio brought next idea :

Puoi mettere online l'intero file?

Bruno

[Marco Porzio]

ciao, temo di no anche perchè è collegato a tabelle su server...
ora credo di essere vicino ad una soluzione, ho fatto in modo da poter gestire 2 eventi sotto a Worksheet_Change.
l'unica cosa che sto riscontrando è che appena aperto il file il codice funziona ma se ho un errore di codice poi non esegue più nulla! ok che non devono esserci bug ma la cosa è strana, stavo cercando un modo per "Riattivare" l'evento Worksheet_Change

detto ciò, qui sotto il codice a cui sono arrivato adesso:

rivate Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo myerror

Application.EnableEvents = False

Dim ccr As Range, acr As Range

Set ccr = Range("A4") '<<< prima cella su cui lavorare dopo aggiornamento del dato
For Each Cell In ccr

Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String

If Not Application.Intersect(Target, Range("A4")) Is Nothing Then

Application.ScreenUpdating = False
Range("C4") = ""
Range("I4") = ""

Set xPTable = Worksheets(ActiveSheet.Name).PivotTables("Tabella pivot1")
Set xPFile = xPTable.PivotFields("FAMILY_CODE")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If IsEmpty(ActiveSheet.Range("A4")) Then ActiveSheet.Range("C4", "F4", "I4").Value = ""

End If

Next Cell





Set acr = Range("C4") '<<< seconda cella su cui lavorare dopo aggiornamento del dato
For Each Cell In acr

Dim xPTable2 As PivotTable
Dim xPFile2 As PivotField
Dim xStr2 As String

If Not Application.Intersect(Target, Range("C4")) Is Nothing Then

Application.ScreenUpdating = False
'Range("C4") = ""
Range("I4") = ""

Set xPTable2 = Worksheets(ActiveSheet.Name).PivotTables("Tabella pivot2")
Set xPFile2 = xPTable2.PivotFields("PROD_TYPE")

Range("F4").FormulaR1C1 = "=IFERROR(MID(RC[-3],SEARCH(""M"",RC[-3])+1,SEARCH(""E"",RC[-3],SEARCH(""M"",RC[-3])+1)-SEARCH(""M"",RC[-3])-1),"""")"

xStr2 = Target.Text
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

If IsEmpty(ActiveSheet.Range("A4")) Then ActiveSheet.Range("F4", "I4").Value = ""

End If



Next Cell

Application.EnableEvents = True

myerror:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub

End Sub

[Marco Porzio]

Ciao,
non ho ricevuto risposte sull'argomento ma torno a chiedere aiuto perchè ho cambiato l'origine dati di una delle pivot e ora quest'ultima non vuole saperne di funzionare!

non capisco perchè era tutto a posto ma solo per una modifica di questo tipo mi blocca tutto...
ci sono altri sistemi per gestire 2 eventi diversi in Worksheet_Change?
grazie
Marco

[Marco Porzio]

aggiungo che ora ho provato un altro codice, anche così al cambio del primo range (Z3) funziona tutto ma su cambio del secondo range (R3) ho un errore in xPFileA.CurrentPage = xStrA (Errore definito dall'applicazione o dall'oggetto)

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

Set xRg = Intersect(Range("Z3"), Target)
If Not xRg Is Nothing Then
MsgBox ("Z3")

Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String

Application.ScreenUpdating = False
Range("C4") = ""
Range("I4") = ""

Set xPTable = Worksheets(ActiveSheet.Name).PivotTables("Tabella pivot2")

Set xPFile = xPTable.PivotFields("PROD_TYPE")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If IsEmpty(ActiveSheet.Range("A4")) Then ActiveSheet.Range("C4", "I4").Value = ""

End If

Set xRg = Intersect(Range("R3"), Target)
If Not xRg Is Nothing Then
MsgBox ("R3")

Dim xPTableA As PivotTable
Dim xPFileA As PivotField
Dim xStrA As String

Application.ScreenUpdating = False
'Range("C4") = ""
Range("I4") = ""

Set xPTableA = Worksheets(ActiveSheet.Name).PivotTables("Tabella pivot3")
Set xPFileA = xPTableA.PivotFields("SUCH15")


xStrA = Target.Text
xPFileA.ClearAllFilters
xPFileA.CurrentPage = xStrA
Application.ScreenUpdating = True

If IsEmpty(ActiveSheet.Range("A4")) Then ActiveSheet.Range("I4").Value = ""

End If

End Sub