vba - Unable to Activate Macro when Active Cell Changes Through formula

Question

My aim is to trigger the advanced filter macro when cell B2 changes (a part of the filtering criteria). B2 is linked to another cell(in another worksheet) which dynamically gets data from external sources. The problem I am facing is that the macro does not activate automatically. Only when I manually change something in B2 is the macro activated. Otherwise the old criteria remains in place. A1 to G1 has the 7 categories and A2-G2 has the inputs for the filter. Only B2 changes effectively. I have not coded in VBA before so most of this code is copied from websites and modified for my workbook. Below is my code. Appreciate any help on this.

Option Explicit
 'Create variable to hold values
Dim Monitored()
Sub Advanced_Filtering()
    Range("A7:G730").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:G2"), CopyToRange:=Sheets("Sheet3").Range("L1:R1")
End Sub
Private Sub Worksheet_Activate()
    Monitored = Range("B2:C2").Value 'Read in value prior to any changes
End Sub
Private Sub Worksheet_Calculate()
    Dim Xrg As Range, c As Range, x As Integer
    Set Xrg = Range("B2:C2")
    If Not Intersect(Xrg, Range("B2:C2")) Is Nothing Then
        Application.EnableEvents = False
         'Compare monitored cell with initial value
        x = 1
        For Each c In Range("B2:C2")
            If c.Value <> Monitored(x, 1) Then
                Call Advanced_Filtering
                Monitored(x, 1) = c.Value
            End If
            x = x + 1
        Next c
         'Reset events
        Application.EnableEvents = True
    End If
End Sub

标签： vba

Answer 1

Probably the easiest fix would be to place the Worksheet_Change event under the cells that generate the value on your cell B2, as changes in formula values don't trigger the Change event... or you can change it to Worksheet_Calculate event instead, this will pick up changes in formula results as below:

Option Explicit
 'Create variable to hold values
Dim Monitored

Sub Advanced_Filtering()
    Range("A7:G730").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:G2"), CopyToRange:=Sheets("Sheet3").Range("L1:R1")
End Sub

Private Sub Worksheet_Activate()
    Monitored = Range("B2").Value 'Read in value prior to any changes
End Sub

Private Sub Worksheet_Calculate()
    Dim Xrg As Range
    Set Xrg = Range("B2")

    If Not Intersect(Xrg, Range("B2")) Is Nothing Then
        Application.EnableEvents = False
         'Compare monitored cell with initial value
        If Range("B2").Value <> Monitored Then
             'Do things as a result of a change
           Call Advanced_Filtering
             'Reset Variable with new monitored value
            Monitored = Range("B2").Value
        End If
         'Reset events
        Application.EnableEvents = True
    End If
End Sub

UPDATE:

To use a Range of cells instead of a single one, you should change the following:

Option Explicit
 'Create variable to hold values
Dim Monitored()

Sub Advanced_Filtering()
    Range("A7:G730").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:G2"), CopyToRange:=Sheets("Sheet3").Range("L1:R1")
End Sub

Private Sub Worksheet_Activate()
    Monitored = Range("B2:C2").Value 'Read in value prior to any changes
End Sub

Private Sub Worksheet_Calculate()
    Dim Xrg As Range, c As Range, x As Integer
    Set Xrg = Range("B2:C2")

    If Not Intersect(Xrg, Range("B2:C2")) Is Nothing Then
        Application.EnableEvents = False
         'Compare monitored cell with initial value
        x = 1
        For Each c In Range("B2:C2")
            If c.Value <> Monitored(1, x) Then
                Call Advanced_Filtering
                Monitored(1, x) = c.Value
            End If
            x = x + 1
        Next c
         'Reset events
        Application.EnableEvents = True
    End If
End Sub