Macro when a font in a range changes

Actually, I just completed a vb code to monitor a dde link and
automatically sends an email. It only send s the email whenever the
dde link passes through a specified target and back. If I didn't have
a comparater then an email would be sent everytime the link changed
value wheteher it was in our out of target range.
The key to this is to have a formula that recalculates the dde link.
In itself it doesn't need to do anything in the vb but this vb code
requires a calculation to start it. Evertime the dde link value
changes it automatically calculates. The only problem with this code
is that when the excel sheet opens, the link is not refreshed and the
code takes a dump, just click ignore and it will complete updating the
dde link and every change after that will re-calculate

Here is the code:

Private Sub Worksheet_Calculate()

'Check to see if it isn alarm
If Range("C11").Value Range("E11").Value Then
Range("B11") = 1

'Check to see if Reset
ElseIf Range("C11").Value Range("F11").Value Then
Range("B11") = 0


End If

'If in alarm send email
If Range("B11") Range("D11") Then
Application.Run ("AutoEmail2.xls!Sheet1.Macro1")

'If in Ok send email
ElseIf Range("B11") Range("D11") Then
Application.Run ("AutoEmail2.xls!Sheet1.Macro2")
End If

End

End Sub
Sub KeyCell()
Dim Cell As Object
Dim myOutlook As Object
Dim myMailItem As Object
' Make instance
Set myOutlook = CreateObject("Outlook.Application")
' Make mail item
Set myMailItem = myOutlook.createitem(0)
' Set recipient (internal mail)
myMailItem.Recipients.Add Range("H11")
'myMailItem.Recipients.Add Range("I11")
' Set recipient (external mail)
'myMailItem.Recipients.Add "
' Set subject
myMailItem.Subject = "Compressed Air Dewpoint out of Tolerance"
' Set body
myMailItem.Body = "Compressed Air Dewpoint is Out of Tolerance" &
vbCr & "At " & Now() & " the dewpoint transitioned to greater than -40
Deg F!" & vbCr & vbCr & "Facilities will investigate cause." & vbCr &
vbCr & "This email was automatically generated by METASYS"
' And send it!
myMailItem.send
' Close instance
Set myOutlook = Nothing

End
End Sub

Sub KeyCell2()
Dim Cell As Object
' If the values in A11:C11 are greater than 50...
'For Each Cell In Range("B11")
' ' If Cell -40 Then
Dim myOutlook As Object
Dim myMailItem As Object
' Make instance
Set myOutlook = CreateObject("Outlook.Application")
' Make mail item
Set myMailItem = myOutlook.createitem(0)
' Set recipient (internal mail)
myMailItem.Recipients.Add Range("H11")

' or insert email address after Add ex.
'myMailItem.Recipients.Add "Gene, Bub"

'myMailItem.Recipients.Add Range("I11")
' Set recipient (external mail)
'myMailItem.Recipients.Add "
' Set subject
myMailItem.Subject = "Compressed Air Dewpoint is back in
Tolerance"
' Set body
myMailItem.Body = "Compressed Air Dewpoint is back in Tolerance" &
vbCr & "At " & Now() & " the dewpoint transitioned to Less than -40 Deg
F!" & vbCr & vbCr & "This email was automatically generated by
METASYS"
' And send it!
myMailItem.send
' Close instance
Set myOutlook = Nothing

End
End Sub

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 6/9/2004 by redwar2x
'

' This macro prompts the another macro to send email when the dde link
transitions to Bad


If Range("B11") Range("D11") Then

Range("B11").Select
Selection.Copy
Range("D11").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Application.Run ("AutoEmail2.xls!Sheet1.KeyCell")
End
End Sub



Sub Macro2()
'
' Macro1 Macro
' Macro recorded 6/9/2004 by redwar2x
'

' This macro prompts the another macro to send email when the dde link
transitions to good

If Range("B11") Range("D11") Then


Range("B11").Select
Selection.Copy
Range("D11").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Application.Run ("AutoEmail2.xls!Sheet1.KeyCell2")
End
End Sub


Hope this helps!
Bud


---
Message posted from http://www.ExcelForum.com/