Send email when any cell in a specific column reads below a certain number...

[afihavok]

Hey All,

I'm completely new to messing with any of this, so I really appreciate your patience and help! I'm attempting to set up a spreadsheet to track maintenance/warranties on gear at work. Basically we have a column for each item, type of warranty, length of warranty, and days left. At this point I have it set up to email me when the value of a specific cell in the Days Left column (column H) reaches 90 (90 days of maintenance left, time to renew). What I'm trying to do is get it to send an email when any cell value in column H hits 90. I've pasted below what I have so far. Instead of "H4" I'm trying to figure out how to say "anything in column 4".

Thanks!

Private Sub Workbook_Open()
Dim w As Worksheet, c As Comment
For Each w In ThisWorkbook.Worksheets
Select Case w.Range("H4").Value
Case Is <= 90
Set c = w.Range("H4").Comment
If c Is Nothing Then
send_mail w.Range("H4").Value, w.Range("I6").Value
ElseIf c.Text <> w.Range("H4").Value & " day reminder sent." Then
send_mail w.Range("H4").Value, w.Range("I6").Value
End If
End Select
Next w
Set c = Nothing
Set w = Nothing
End Sub
Private Function send_mail(numdays As Variant, eaddress As String)
Dim O, m
Set O = CreateObject("Outlook.Application")
Set m = O.CreateItem(0)
With m
.To = eaddress
.CC = ""
.BCC = ""
.Subject = "Maintenance Warning"
.Body = "There are one or more items with less than 90 days of maintenance left."
.Display 'or use .Display
End With
Set m = Nothing
Set O = Nothing
End Function

[Logit]

.
I already had something like this in my folder.

Paste this into a Routine Module :

Option Explicit

Sub EmailNotice()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim strTo As String
    Dim strSubject As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strTo = "me@yahoo.com ; you@yahoo.com; them@yahoo.com; us@yahoo.com"
    
    strSubject = "Low Inventory Warning"
    
    strbody = "Inventory is below 600cs. Please review" & _
              " " & vbNewLine & _
              "Do not respond to this email as this is an automated response message. " & _
              " " & vbNewLine & _
              " " & vbNewLine & _
              "Sincerely, " & _
              " " & vbNewLine & _
              " " & vbNewLine & _
              "Hal ... Your computerized messaging system." & vbNewLine & _
              "( Wear nothin kin goe wrung. ) "

    On Error Resume Next
    With OutMail
        .To = strTo
        .CC = ""
        .BCC = ""
        .Subject = strSubject
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display       'If uncommented the email will display first and await user interaction
        'or use .Send
        '.Send           'Using .Send allows the email to send without user interaction, i.e., automatically
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

Paste this into the Sheet Level module where the <=90 will appear in Column H:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Do nothing if more than one cell is changed or content deleted

   If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

      

        With Target.Range("H2:H100") '<--- change range as required
    
           If Target.Value <=90 Then
    
                'Stop any possible runtime errors and halting code
    
                On Error Resume Next
    
                    'Turn off ALL events so the Target * 2 does not _

                    'put the code into a loop.
    
                    Application.EnableEvents = False
    
                    EmailNotice 'calls the email macro
                    
                    'Turn events back on
    
                    Application.EnableEvents = True
    
                'Allow run time errors again
    
                On Error GoTo 0
    
            End If
        End With
    'End If

End Sub

[afihavok]

I really appreciate your help! I couldn't get the email to pop up when I first tried but I admittedly haven't spent much time on it. I'll keep working and let you know how it goes. Thanks again.

[Logit]

.
Look at this attached

[afihavok]

Thanks for the quick reply. Is there a way to get it to display the email when the workbook is opened? I had to run the macro to get it to pop up. (Changed email address in module.)

[Logit]

.
Paste this into the ThisWorkbook Module :

Option Explicit

Private Sub Workbook_Open()
    EmailNotice
End Sub

[afihavok]

Okay, I'm slowly getting there! It's now popping up the email but doing it every time, regardless of what I have in the range. I changed it to H2:H5 just for testing and put 1000 in each of those cells.

[Logit]

.
I've been exploring how to check (when the workbook is opened) if there is a value in Col H less than 90. Guess my old mind is tired. Haven't got there yet.

Understand this is not a professional endeavor for me ... just a hobby. I'll keep pluggin' away.

By the way, I didn't fully test that last file I sent. There was an error in it. Try this one.

[Logit]

.
Paste this macro in the ThisWorkbook module :

Option Explicit

Private Sub Workbook_Open()
    ToRunOnStartup
End Sub

Paste this in the Routine Module below the email macro

Sub ToRunOnStartup()
Dim found As Boolean
Dim cell As Variant

found = False
    For Each cell In Range("H2:H100").Cells
        If cell.Value <= 90 Then             'edit value as required
            found = True
        End If
    Next
    
    If found = True Then
        EmailNotice
    Else
        Exit Sub
    End If
End Sub

Review the attached.

[afihavok]

That did it! I can't tell you how much I appreciate your help. I owe you a beer or 12. I'll let you know how the final product turns out. Thanks again!

[Logit]

.
Great ! Glad to help.

You'll need to keep the beer with all the bad stuff happening in Tx right now.