CODEWITHSUNDEEP
vbaexcel
Robert Martin
Robert Martin

Reputation: 17157

How can I run my Excel macro when a specific cell changes? [new twist]

I googled around, and I wrote the following code that I want to run only when a specific cell, D4, changes:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Static EmailSent As Boolean
    Dim Threshold As Integer
    Dim Cell As String, Email As String, Msg As String

    Cell = "D4"
    Threshold = 100
    Email = Range("E7").Value


    Set KeyCells = Range(Cell)

    If Not Application.Intersect(Range(Cell), Range(Target.Address)) Is Nothing Then
        Dim x As Integer
        x = Range(Cell).Value

        If x >= Threshold Then
            EmailSent = False
        ElseIf x < Threshold And Not EmailSent Then
            EmailSent = True
            Msg = "You only have " & x & " widgets remaining."
            MsgBox Msg
            SendMail Email, Msg
        End If
    End If
End Sub

This works, and I know there are a lot of similar questions here. But here's where I'm having trouble: this only works if I set D4 to an explicit value, say "48". I want it to work even if D4 is a formula: so if D4 is "=SUM(A4:C4)" then an email should send if that sum drops below 100. This code won't send an email in that case :-(

Does anyone know how to fix this?

Upvotes: 2

Views: 4959

Answers (2)

Nigel Heffernan
Nigel Heffernan

Reputation: 4726

You need to check your cell when any of the contributing cells change, then. If they're in the same sheet, this will work:

Try this: 


Private Sub Worksheet_Change(ByVal Target As Range)



Static varD4_old As Variant ' Static variables retain their value between calls



Dim varD4 As Variant



varD4 = Range("D4").Value



If varD4 <> varD4_old Then
    Debug.Print "D4 changed from " & varD4_old & " to " & varD4
    varD4_old = varD4
  ' NOW RUN MY CHANGE CODE
End If



End Sub

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166615

Private Sub Worksheet_Calculate()
    CheckForMail
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    CheckForMail Target
End Sub


Sub CheckForMail(Optional rng As Range = Nothing)

    Static EmailSent As Boolean
    Dim KeyCells As Range
    Dim Threshold As Integer
    Dim Cell As String, Email As String, Msg As String
    Dim x As Integer

    Cell = "D4"
    Set KeyCells = Me.Range(Cell)

    'if called from worksheet_change, check the range
    If Not rng Is Nothing Then
        If Application.Intersect(KeyCells, rng) Is Nothing Then
            Exit Sub
        End If
    End If

    Threshold = 100
    Email = Me.Range("E7").Value
    x = KeyCells.Value

    If x >= Threshold Then
        EmailSent = False
    ElseIf x < Threshold And Not EmailSent Then
        EmailSent = True
        Msg = "You only have " & x & " widgets remaining."
        MsgBox Msg
        SendMail Email, Msg
    End If

End Sub

Upvotes: 4

Related Questions