VBA to update formula when a value changes in a refence range

问题

I have an Excel formula that gives me the last Friday's date "=TODAY()-WEEKDAY(TODAY())-1" in cell A1

I want to update cell A1 only when the values in reference range in another worksheet B2:D469 changes.

Below is the code i am using but the issue is code only works when i manually make a change in the range. However values in the range gets updated when source pivot table refresh. I want code to get updated when i refresh the pivot table and the values in the range "B2:D469" changes.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Worksheets.("Source").Range("B2:D469")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

Worksheets.("Dashboard").Range ("A1").EnableCalculation = True

End If
End Sub

回答1:

Range.Dependents

Range has a property Dependents which is a Range containing all cells that this Range affects, even if they are several steps removed. For example if C4 is "=B4" and B4 is "=A4", Range("A4").Dependents will include both B4 and C4.

So, in your case, if Target affects a cell you care about, it's included in the Range Target.Dependents. You can use this to accomplish your goal.

How to use it

Use the following as the code of ThisWorkbook. I've commented the heck out of it, but if you have questions feel free to ask in the comments.

Option Explicit

Private RangeToMonitor As Range
Private RangeToChange As Range

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    '---If this is the first change since the workbook has been opened, define the ranges---
    If RangeToMonitor Is Nothing Then
        Set RangeToMonitor = Worksheets("Source").Range("B2:D469")
        Set RangeToChange = Worksheets("Dashboard").Range("A1")
    End If
    '---------------------------------------------------------------------------------------

    'First, check to see if Target is in the RangeToMonitor
    If Not Application.Intersect(Target, RangeToMonitor) Is Nothing Then
        'If so, set your date. Rather than using a formula in the cell - which could go haywire if someone messes with it - just set it straight from VBA
        RangeToChange.Value = Date - Weekday(Date) - 1
    'Second, check to see if a change to Target *triggers* any recalculation of cells in RangeToMonitor.
    'You can do this by looking at Dependents, which is all the cells affected by a change to Target, even several steps removed
    ElseIf hasDependents(Target) Then
        '(The above and below criteria cannot be done in one if condition because VBA boolean operators do not short circuit)
        If Not (Application.Intersect(Target.Dependents, RangeToMonitor) Is Nothing) Then
            RangeToChange.Value = Date - Weekday(Date) - 1
        End If
    End If
End Sub


'The reason for this function is that trying to use Target.Dependents when Target has no Dependents causes an error
'I use this function to verify that Target DOES have Dependents before attempting to find out if any of them affects RangeToMonitor
Private Function hasDependents(rng As Range)
On Error GoTo ErrHandler
    Dim test As Long
    test = rng.DirectDependents
    hasDependents = True
    Exit Function

ErrHandler:
    If Err.Number = 1004 Then
        '"No Cells Were Found"
        'This error signifies that Target has no Dependents, so we can safely ignore the change and exit the event.
        hasDependents = False
    Else
        Err.Raise Err.Number, , Err.Description
    End If
End Function

来源：https://stackoverflow.com/questions/41877029/vba-to-update-formula-when-a-value-changes-in-a-refence-range

标签

vba

excel