VBA change Case to look for LIKE string - vba

Question

How can I change this code used to select page items in an XL pivotTable
Dim pvtSM1 As PivotTable
Dim pviSM1 As PivotItem
Dim pvfSM1 As PivotField
Set pvtSM1 = ActiveSheet.PivotTables("SM1")
' set Pivot field variable to "RESULT"
Set pvfSM1 = pvtSM1.PivotFields("RESULT")
' loop through all Pivot Items in "RESULT" Pivot Field
For Each pviSM1 In pvfSM1.PivotItems
Select Case pviSM1.Name
Case "4K2..00", "4K21.00", "4K22.00", "4K23.00", "4K41.00", "4K42.00", "4K43.00", "4KA1.00", "4KA2.00"
pviSM1.Visible = True
Case Else
pviSM1.Visible = False
End Select
Next pviSM1
End With
...into a LIKE "4K2*", "4K4*", "4KA*"
To save me adding all the exact codes

Answer 1

Dim pvtSM1 As PivotTable
Dim pviSM1 As PivotItem
Dim pvfSM1 As PivotField
I swear, I read them 5 times (okay, 3) before I figured out the [single-character] difference between them. And I've no idea whatsoever what SM1 might stand for. Suggestion:
Dim pvtTable As PivotTable
Dim pvtItem As PivotItem
Dim pvtField As PivotField
Use meaningful names that you can read out loud without sounding like an Ewok.
Better suggestion - declare variables closer to where you're using them, instead of in a wall of declarations at the top of your procedure; and then use Comintern's suggestion to get rid of the Select Case block altogether:
Dim pvtTable As PivotTable
Set pvtTable = MyPivotTableSheet.PivotTables("SM1") ' don't assume what the ActiveSheet is
Dim pvtField As PivotField
Set pvtField = pvtTable.PivotFields("RESULT")
Dim pvtItem As PivotItem
For Each pvtItem In pvtField.PivotItems
pvtItem.Visible = pvtItem.Name Like "4K[24A]*"
Next
And heck, naming is hard - don't name things per their type, name things per their purpose.
The code throws a runtime error if PivotTables("SM1") doesn't exist, or if PivotFields("RESULT") doesn't refer to anything. The best way to avoid this is to separate the concerns into small, specialized functions, that do one thing and that do it well:
Private Function FindPivotTable(ByVal sheet As Worksheet, ByVal name As String) As PivotTable
If sheet Is Nothing Then Err.Raise 5, "FindPivotTable", "'sheet' argument cannot be Nothing"
On Error Resume Next
Dim result As PivotTable
Set result = sheet.PivotTables(name)
On Error GoTo 0
Err.Clear
If result Is Nothing Then
Err.Raise 9, "FindPivotTable", "Could not locate pivot table '" & name & "' on worksheet '" & sheet.Name & "'."
Exit Function
End If
Set FindPivotTable = result
End Function
Private Function FindPivotField(ByVal pivot As PivotTable, ByVal name As String) As PivotField
If pivot Is Nothing Then Err.Raise 5, "FindPivotField", "'pivot' argument cannot be Nothing"
On Error Resume Next
Dim result As PivotField
Set result = pivot.PivotFields(name)
On Error GoTo 0
Err.Clear
If result Is Nothing Then
Err.Raise 9, "FindPivotField", "Could not locate pivot field '" & name & "' in pivot table '" & pivot.Name & "'."
Exit Function
End If
Set FindPivotField = result
End Function
Now your procedure can focus on its task, and you can reuse these specialized functions instead of either writing frail error-prone code, or copy-pasting the same fail-safe code over and over again:
On Error GoTo ErrHandler
Dim sourcePivot As PivotTable
Set sourcePivot = FindPivotTable(MyPivotTableSheet, "SM1")
If sourcePivot Is Nothing Then Exit Sub
Dim resultField As PivotField
Set resultField = FindPivotField(sourcePivot, "RESULT")
If resultField Is Nothing Then Exit Sub
Dim item As PivotItem
For Each item In resultField.PivotItems
item.Visible = item.Name Like "4K[24A]*"
Next
Exit Sub
ErrHandler:
MsgBox "Error in '" & Err.Source & "': " & Err.Description
...yet it still feels bloated, so I'd take that and parameterize it, so that it works off targetField - and since that's supposed to be "RESULT", I'll call the parameter resultField:
Private Sub SetItemVisibilityByPattern(ByVal resultField As PivotField, ByVal likePattern As String)
If resultField Is Nothing Then Exit Sub
Dim item As PivotItem
For Each item In resultField.PivotItems
item.Visible = item.Name Like likePattern
Next
End Sub
And now it's the caller's responsibility to figure out how resultField gets there, and you're left with a very, very simple procedure that does one single thing.
Like works, for basic pattern searches. When you start having need for more complicated patterns (e.g. match "4K2*" but also "685*"), consider using a regular expression pattern (here referencing the Microsoft VBScript Regular Expressions 5.5 library):
Private Sub SetItemVisibilityByPattern(ByVal resultField As PivotField, ByVal regexPattern As String)
If resultField Is Nothing Then Exit Sub
With New RegExp
.Pattern = regexPattern
Dim item As PivotItem
For Each item In resultField.PivotItems
item.Visible = .Execute(item.Name).Count > 0
Next
End With
End Sub
With a single regular expression pattern you can match anything you like, with as many possible alternatives as you need:
SetItemVisibilityByPattern(resultField, "(4K[24A]|685|923).*")

Answer 2

If you really want select case with likes here's bulky example:
Sub test()
Dim str As String
str = InputBox("feed me a string")
Select Case str Like "4K[24A]*"
Case True
Call MsgBox("Da!")
'pviSM1.Visible = True
Case False
Call MsgBox("Net!")
'pviSM1.Visible = false
End Select
End Sub