Filter Pivot table based on cell value with multiples value separate (with comma)

[urubag]

Hi Mr Excel Community,

Please note I have a report and already have a macro that user be able to select multiple options in dropdown (Data Validation List) (Range C4) but now I need that everytime C4 changed the pivot table be updated with the values according the cell. I already have the code to do it when the cell value C4 has one item but now I have multiples separate from Comma.

This code works for individual values.

If Target.Address = Range("C4").Address And Range("C4").Value <> Empty Then

        ActiveSheet.PivotTables("TablePi").PivotFields("CoCd").ClearAllFilters
        ActiveSheet.PivotTables("TablePi").PivotFields("CoCd").PivotFilters.Add Type:=xlCaptionEquals, Value1:=Range("C4").Value
        
   End If

But I need the pivot table be filtered when Cell C4 as example: 300, 400, 500 (It can be any number and no limit of values) so the pivot table can show data related with those values separated with the comma.

Appreciate any idea!
Regards
Andres

 

[DanteAmor]

Hello @urubag.

Cell C4 as example: 300, 400, 500

Verify that the format of cell C4 is text, only in case you write for example 100,200, Excel does not consider it as a numeric value 100200 instead of 2 items 100 and 200.

Use the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim pItm As PivotItem
  Dim FilterArr As Variant, aItm As Variant
  Dim bExists As Boolean
  Dim n As Long

  If Not Intersect(Target, Range("C4")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    
    FilterArr = Split(Target.Value, ",")
    With ActiveSheet.PivotTables("TablePi").PivotFields("CoCd")
      .ClearAllFilters
      n = 0
      For Each pItm In .PivotItems
        bExists = False
        For Each aItm In FilterArr
          If Trim(aItm) = pItm.Value Then
            bExists = True
            Exit For
          End If
        Next
        If bExists = False Then
          n = n + 1
          If n < .PivotItems.Count Then
            pItm.Visible = False
          Else
            .ClearAllFilters
            MsgBox "The value does not exist"
          End If
        End If
      Next
    End With
  
  End If
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[urubag]

Hello @urubag.


Verify that the format of cell C4 is text, only in case you write for example 100,200, Excel does not consider it as a numeric value 100200 instead of 2 items 100 and 200.

Use the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim pItm As PivotItem
  Dim FilterArr As Variant, aItm As Variant
  Dim bExists As Boolean
  Dim n As Long

  If Not Intersect(Target, Range("C4")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
   
    FilterArr = Split(Target.Value, ",")
    With ActiveSheet.PivotTables("TablePi").PivotFields("CoCd")
      .ClearAllFilters
      n = 0
      For Each pItm In .PivotItems
        bExists = False
        For Each aItm In FilterArr
          If Trim(aItm) = pItm.Value Then
            bExists = True
            Exit For
          End If
        Next
        If bExists = False Then
          n = n + 1
          If n < .PivotItems.Count Then
            pItm.Visible = False
          Else
            .ClearAllFilters
            MsgBox "The value does not exist"
          End If
        End If
      Next
    End With
 
  End If
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

Hi @DanteAmor Thanks for the response unfortunately the code is giving error, maybe this image help you to understand the requirement.

Range("C4").value can have 1 or multiple values separated by comma so the idea is used Worksheet change so everytime C4 changed, pivot table can show the respective data related with the values in cell C4 separated by comma. The thing I am not sure how to tell VBA to filter the pivot table based on cell C4 when it contains more than one value separately by comma.

Cell C4 is a dropdown (Validation list) so all values in the dropdown exists. When the C4 Value has more than 1 value separately by comma, is because user selects diferent values in the dropdown and other macro basically concatenate the values in the same cell so the VBA code required needs to show the data according 1 value or the values separated by comma (C4).

I am looking for small vba code but I will receive any vba code that acomplish this requirement since its a lit bit tricky not sure if someone already tried something like this.

Urubag

 

[DanteAmor]

unfortunately the code is giving error

What does the error say?
And at which line of the macro does it stop?

Range("C4").value can have 1 or multiple values separated by comma so the idea is used Worksheet change so everytime C4 changed

That's what the macro does.


These are my tests, so that you can see that the macro does what you ask for.

Before any value in cell C4:

After inserting multiple values into C4 separated by commas:

​

Your image shows nothing, everything is erased.
It would help if your example is clearer; as well as my example.


--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

 

[urubag]

Understood @DanteAmor

Spoiler: Error

This is the full code I am using in worksheet change + yours

Spoiler

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

Dim oldval As String
Dim newval As String

    If Target.Address = "C4" Then Exit Sub
    If Target.Row = 4 Then
        newval = Target.Value
        If newval <> "" Then
            Application.EnableEvents = False
            Application.Undo
            oldval = Target.Value
            If InStr(oldval, newval) = 0 Then
                Target.Value = IIf(oldval = "", "", oldval & ",") & newval
            End If
            Application.EnableEvents = True
        End If
    End If
    
    '_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _

'Danteamor code
  
Dim pItm As PivotItem
Dim FilterArr As Variant, aItm As Variant
Dim bExists As Boolean
Dim n As Long

  If Not Intersect(Target, Range("C4")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    
    FilterArr = Split(Target.Value, ",")
    With ActiveSheet.PivotTables("TablePi").PivotFields("CoCd")
      .ClearAllFilters
      n = 0
      For Each pItm In .PivotItems
        bExists = False
        For Each aItm In FilterArr
          If Trim(aItm) = pItm.Value Then
            bExists = True
            Exit For
          End If
        Next
        If bExists = False Then
          n = n + 1
          If n < .PivotItems.Count Then
            pItm.Visible = False
          Else
            .ClearAllFilters
            MsgBox "The value does not exist"
          End If
        End If
      Next
    End With
  
  End If
  
    '_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _

   If Target.Address = Range("C5").Address And Range("C5").Value <> Empty Then
   
        ActiveSheet.PivotTables("TablePi").PivotFields("CoCd").ClearAllFilters
        ActiveSheet.PivotTables("TablePi").PivotFields("CoCd").PivotFilters.Add Type:=xlCaptionEquals, Value1:=Range("C5").Value
        Range("C4").ClearContents
        
   End If
    
    If Target.Address = Range("C6").Address And Range("C6").Value <> Empty Then
    
        ActiveSheet.PivotTables("TablePi").PivotFields("Approver ID").ClearAllFilters
        ActiveSheet.PivotTables("TablePi").PivotFields("Approver ID").PivotFilters.Add Type:=xlCaptionEquals, Value1:=Range("C6").Value
            
    End If

Application.ScreenUpdating = True
End Sub

This is the expectation image as yours, I cannot share the file due confidencial reasons and that why some parts are obfuscated.

Spoiler: Expectation Result

Hope this helps
Urubag

 

[DanteAmor]

In the future, please put all your code to test your code with the new code, as you know, we are not magicians to know that you have other codes that affect the operation of what we are proposing to you, then come back. here and comment: "unfortunately, the code is giving error". And it doesn't seem fair to me, since the problem may be part of your code.

I can't reproduce that error.
Do me a favor, change all your code to the following code and try again.

Private Sub Worksheet_Change(ByVal Target As Range)

  'Danteamor code
    
  Dim pItm As PivotItem
  Dim FilterArr As Variant, aItm As Variant
  Dim bExists As Boolean
  Dim n As Long

  If Target.Count > 1 Then Exit Sub
  
  If Not Intersect(Target, Range("C4")) Is Nothing Then
    Application.ScreenUpdating = True
   
    FilterArr = Split(Target.Value, ",")
    With ActiveSheet.PivotTables("TablePi").PivotFields("CoCd")
      .ClearAllFilters
      n = 0
      For Each pItm In .PivotItems
        bExists = False
        For Each aItm In FilterArr
          If Trim(aItm) = pItm.Value Then
            bExists = True
            Exit For
          End If
        Next
        If bExists = False Then
          n = n + 1
          If n < .PivotItems.Count Then
            pItm.Visible = False
          Else
            .ClearAllFilters
            MsgBox "The value does not exist"
         End If
        End If
      Next
    End With
  End If
  
    '_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _

   If Target.Address = Range("C5").Address And Range("C5").Value <> Empty Then
        ActiveSheet.PivotTables("TablePi").PivotFields("CoCd").ClearAllFilters
        ActiveSheet.PivotTables("TablePi").PivotFields("CoCd").PivotFilters.Add Type:=xlCaptionEquals, Value1:=Range("C5").Value
   End If
    
  If Target.Address = Range("C6").Address And Range("C6").Value <> Empty Then
      ActiveSheet.PivotTables("TablePi").PivotFields("Approver ID").ClearAllFilters
      ActiveSheet.PivotTables("TablePi").PivotFields("Approver ID").PivotFilters.Add Type:=xlCaptionEquals, Value1:=Range("C6").Value
  End If

  Application.ScreenUpdating = True
End Sub

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

 

[urubag]

Hi @DanteAmor

Your code works from single perspective but with my whole code not works, appreciate your help ansd your time...

Unfortunately you removed a code that is required so the code be able to work with the code I showed you, however I was thinking in something different that maybe can be easier . Can you please try to filter the pivot table based on range("A1:L1") values without blank. This range (12 cells) will receive values so the idea is to filter per the values but I dont want to see blank as visible.

Regards