Sending Email from excel dependant on a calcuted cell
Posted by Phil on June 01, 2001 8:27 AM
********************************************
ORIGINAL MESSAGE BELOW
********************************************
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
********************************************
END MESSAGE
********************************************
********************************************
NEW MESSAGE
********************************************
Dax gave me this piece of VBA for sending an email alert if the value of B drops below the value of A...
Unfortunatly it doesn't work if the value in "B" is a calculation - e.g =C1+C2
any1 got any suggestion.....
********************************************
END NEW MESSAGE
********************************************
below is the script from DAX (thanxs)...
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 = "howell_p@manro-pc.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
Posted by David Rainey on June 01, 2001 8:36 AM
I did something like this once.
you need something to compare it to so use another cell.
if the worksheet changes then compare it to your 2nd cell. If they are different then you value changed.
then see if your value is what it needs to be for the email
did you understand any of this?
Posted by david on June 01, 2001 8:41 AM
This might be clearer
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Range("D5") <> Range("E5") Then
If Range("D5") < 3 Then
'Send email
End If
Range("E5") = Range("D5")
End If
End Sub
Posted by Dax on June 01, 2001 9:53 AM
'If the SendAnEmail variable is true then this code sends an email
Hello again Phil,
The code isn't working because it only checks when a user directly alters a cell in either column A or B. This (shortened) code will execute after a user changes any cell in the worksheet. It will check that the value in column CurrentLevel column (I've used column 2 or B) is greater than the level in MinimumLevelColumn (column 1 or A).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OLook As Object 'Outlook.Application
Dim Mitem As Object 'Outlook.Mailitem
Dim MinimumLevelColumn As Integer
Dim CurrentLevelColumn As Integer
'Change these depending on your spreadsheet
MinimumLevelColumn = 2
CurrentLevelColumn = 1
If Cells(Target.Row, CurrentLevelColumn) < Cells(Target.Row, MinimumLevelColumn) Then
Set OLook = CreateObject("Outlook.Application")
Set Mitem = OLook.createitem(0)
Mitem.to = "howell_p@manro-pc.com"
Mitem.Subject = "Stock level warning!"
Mitem.body = "Current stock level in row " & 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.
