VBA to Read Formula Generated Numbers

[Jack R]

Hi! I’m trying to get my macro to run when a column of numbers (based on formulas) contains a specific number. Basically, I want VBA to read the number not the formula in this column.

I am working on a spreadsheet of material that will expire at various points in time. Currently, I have a column containing “days until expiration” that are run on their expiration date minus today.

ex.) =H5-TODAY()

I want my macro to send an email to a few of my coworkers (I already have this code) when we are 180 days from expiration, but VBA isn’t reading the number in the cell, it only triggers when I manually enter 180 into the cell.

Any thoughts on how to fix this?

Here’s the code:

Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("I2:I99"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value = 180 Then
Call Mail_small_Text_Outlook
End If
End Sub

 

[pbornemeier]

If you have a bunch of formulas on the page it is likely that more than one cell at a time changes and the If Target.Cells.Count > 1 Then Exit Sub line keeps the rest of the code from operating. When you edit a single cell, that is the only one changing so the code continues past that line. This code checks each changed cell and if it is in the defined range and equals 180 executes Mail_small_Text_Outlook. I am not sure if Outlook could handle 98 calls at once (if all of the cells changed at once) so I added the Exit Sub after the first Call statement.

Option Explicit

Dim xRg As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    'Check each changed cell.  If it in I2:I99 and it equals 180 then call
    '  Mail_small_Text_Outlook.  Exit Sub is present to ensure only 1 cell
    '  is processed.  If it is likely that multiple cells will change to 180 at the same time
    '  then you may want to check out Chip Pearson's Shell & Wait code at
    '  www.cpearson.com/Excel/ShellAndWait.aspx 
    
    Dim rngCell As Range
    
    On Error Resume Next
    For Each rngCell In Target
        If Not Intersect(Range("I2:I99"), rngCell) Is Nothing Then
            If IsNumeric(Target.Value) And Target.Value = 180 Then
                Set xRg = rngCell
                Call Mail_small_Text_Outlook
                Exit Sub  'may not be needed depending on what you want
            End If
        End If
    Next
End Sub