MrExcel Publishing
Your One Stop for Excel Tips & Solutions

send an email message when a cells value is below 20


Posted by phil on May 31, 2001 6:59 AM

Hi,

Does any1 know how i can send a set message (eg stock levels are low) through email - if a cells value drops below a certain level.

e.g.

collumn A has the min stock level
collumn b has the current stock level

i want an email to be set to me if the current stock level (collumn B) goes below the minimum stock level (collumn C)....


Any help is greatly appriecated

Phil


Posted by Dax on May 31, 2001 9:33 AM

Hello,

If you're using Outlook then you could use this bastardised code from something I wrote a little while ago. The code could definitely be improved but I'm sure this will give you a headstart. You need to paste it into the Worksheet code module (Right-click the worksheet tab and click View Code. Then paste.)


Private Sub Worksheet_Change(ByVal Target As Range)
Dim OLook As Object 'Outlook.Application
Dim Mitem As Object 'Outlook.Mailitem
Dim SendAnEmail As Boolean

'Is the changed cell in column A or B and not in row 1. If not then exit.
If (Target.Column <> 1) And (Target.Column <> 2) And (Target.Row <> 1) Then Exit Sub


If Target.Column = 1 Then 'Column A has changed
'Is column B value < column A value? Send an email if yes.
If Target.Offset(0, 1).Value < Target.Value Then SendAnEmail = True
Else
If Target.Column = 2 Then 'Column B has changed
'Is column A value > column B value? Send an email if yes.
If Target.Offset(0, -1).Value > Target.Value Then SendAnEmail = True
End If
End If

'If the SendAnEmail variable is true then this code sends an email
'from Outlook. Change the properties to suit your needs.
If SendAnEmail Then
Set OLook = CreateObject("Outlook.Application")
Set Mitem = OLook.createitem(0)
Mitem.to = "dave@somedump.com"
Mitem.Subject = "Stock level warning!"
Mitem.body = "Current stock level in " & Target.Row & " of spreadsheet" & _
" has fallen below minimum stock level"
Mitem.send
End If

'Destroy any object references
Set OLook = Nothing
Set Mitem = Nothing
End Sub


HTH,
Dax.

Posted by Phil on May 31, 2001 3:28 PM

Cheers worked 1st time & better than than i expected - Cheers..!

;-)