How to Merge Two Worksheet_Change events into one-CodePudding

I am fairly new to VBA and struglling with the idea on how to merge both of these subs into one, as i need to enable dynamic filters for two separate Pivots.

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 Intersect(Target, Range("L3:L4")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Summary").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Machine")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

To combine with this

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 Intersect(Target, Range("P16:P17")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Summary").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Machine")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

Appreciate any help, thank you!

CodePudding user response：

Rather than just Exiting if there is no intersection, flip it around and proceed if there is an intersection.

Your code, refactored along with a few other improvements

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String

    Application.ScreenUpdating = False
    If Target.CountLarge > 1 Then
        ' User changed >1 cells.  What now?
        Exit Sub
    End If
        
    ' On Error Resume Next   <~~ don't do this globally!
    If Not Intersect(Target, Me.Range("L3:L4")) Is Nothing Then
        On Error Resume Next '<~~ Keep it tight around a potential error
            ' If the Change event is on Sheet Summary, use Me instead
            Set xPTable = Me.PivotTables("PivotTable1")
            ' If the Change Event is NOT on Sheet Summary, be explicit on the workbook
            'Set xPTable = Me.Parent.Worksheets("Summary").PivotTables("PivotTable1")
        On Error GoTo 0
    ElseIf Not Intersect(Target, Me.Range("P16:P17")) Is Nothing Then
        On Error Resume Next 
            Set xPTable = Me.PivotTables("PivotTable2")
        On Error GoTo 0
    End If
    
    If Not xPTable Is Nothing Then
        On Error Resume Next '<~~ in case Machine doesn't exist
            Set xPFile = xPTable.PivotFields("Machine")
        On Error GoTo 0
        If Not xPFile Is Nothing Then
            xStr = Target.Value  ' .Text is dangerous. Eg it can truncate if the column is too narrow
            xPFile.ClearAllFilters
            xPFile.CurrentPage = xStr
        End If
    End If

    Application.ScreenUpdating = True
End Sub

CodePudding user response：

I think there are more options for refactoring.

Put the basic routine into a seperate sub in a modul. This sub can then be called from the _change-events of both sheets. Advantage: if you want to change the logic of the sub - you do it in one place, not two. Or maybe there will be a third sheet that wants to use the same logic. (DRY-principle: don't repeat yourself)

I like to "externalize" on error resume next if necessary into tryGet-functions. Thereby minimizing the risk of its usage (which is in this case ok)

This is the generic sub - based on chris neilsens suggestion plus the comments from VBasic2008

Maybe you adjust the name of the sub to be more precise in what you want to achieve.

Public Sub handleMachineField(Target As Range, RangeToCheck As Range, PTName As String)

On Error GoTo err_handleMachineField

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

    Application.ScreenUpdating = False
    
    If Target.CountLarge > 1 Then
        ' User changed >1 cells.  What now?
        Exit Sub
    End If
        
    If Not Intersect(Target, RangeToCheck) Is Nothing Then
        Set xPTable = tryGetPivotTable(Target.Parent, PTName)
    End If
    
    If Not xPTable Is Nothing Then
        Set xPFile = tryGetPivotField(xPTable, "Machine")
        If Not xPFile Is Nothing Then
            xStr = Target.Value  ' .Text is dangerous. Eg it can truncate if the column is too narrow
            Application.EnableEvents = False
                xPFile.ClearAllFilters
                xPFile.CurrentPage = xStr
            Application.EnableEvents = True
        End If
    End If
    
exit_handleMachineField:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub

err_handleMachineField:
    MsgBox Err.Description
    Resume exit_handleMachineField
    
End Sub



Public Function tryGetPivotTable(ws As Worksheet, PTName As String) As PivotTable
'in case pivot table does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
    Set tryGetPivotTable = ws.PivotTables(PTName)
On Error GoTo 0

End Function

Public Function tryGetPivotField(pt As PivotTable, FieldName As String) As PivotField
'in case field does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
    Set tryGetPivotField = pt.PivotFields(FieldName)
On Error GoTo 0

End Function

And this is how you would call it form the worksheet events:

Private Sub Worksheet_Change(ByVal Target As Range)
handleMachineField Target, Me.Range("L3:L4"), "PivotTable1"
End Sub

By the way: this is another advantage of putting the check into a sub. When reading the code in the change-event you immediately know what will happen - you don't have to read through all the code lines to understand what is going on.