CODEWITHSUNDEEP
vbaexcel
BradleyS
BradleyS

Reputation: 215

VBA change Case to look for LIKE string

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

Upvotes: 0

Views: 387

Answers (2)

CommonSense
CommonSense

Reputation: 4482

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

Upvotes: 0

Mathieu Guindon
Mathieu Guindon

Reputation: 71167

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).*")

Upvotes: 8

Related Questions