Hi

I have an Excel sheet that tracks Action Items
I wrote a formula that each time an Action Item is Over Due the status changes to "Over Due"

I need a macro that will recognize that automatically and will copy the specific row and send an email to the person responsible for this Action Item with a message "Your Action Item is Over Due….."

You can find the Excel sheet in Hi

I have an Excel sheet that tracks Action Items
I wrote a formula that each time an Action Item is Over Due the status changes to "Over Due"

I need a macro that will recognize that automatically and will copy the specific row and send an email to the person responsible for this Action Item with a message "Your Action Item is Over Due….."

You can find the Excel sheet in ftp://dannyn:[email protected]/


Can you please help?

Thanks



Can you please help?

Thanks

I was unable to access your Excel file, pls let me have it on my email addr [email protected]

I am after the same thing, well sort of.

I have a spreadsheet that has various columns but their are two columns of interest one is the 'Name' column and the other is the 'Due Date' column. When a Due Date in the column on the spread sheet matches that of the computer data I want it to send an email to a specific person or persons with the information from the 'Name' column automatically, and giving the email a subject of 'Date for review now due'

Can anyone help or point me in the right direction.. It would be very much appreciated.

Regards

John

have a bash at this, things to consider are that to ensure that emails are not sent in an automated and spamming nature microsoft have set the feature of requiring a confirmation for the email to be sent before it actually goes...
Assumptions...
there is only one cell beingclassed as overdue. but if there isn't you can have a loop to search for each instance of the "Over Due" phrase.
The email recipient name in the code should be changed to that of a parameterised cell content, or similar, to allow for the different users.
Change the subject line text to what ever you want.

Sub sendemail()

Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer

    Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate

    myRow = ActiveCell.Row
    ActiveSheet.Range("A" & myRow).Select

    Application.ScreenUpdating = False

    For myLoop = 1 To 255
        If ActiveCell.Value = "" Then myBodyText = myBodyText & "" & ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
        If ActiveCell.Column = 256 Then myBodyText = myBodyText Else ActiveCell.Offset(0, 1).Select
    Next
    myBodyText = myBodyText & " " & ActiveCell.Value

    Set OutlookApp = CreateObject("Outlook.Application")
     With OutlookApp.CreateItem(olMailItem)
        .Subject = "My Subject Line"
        .Body = myBodyText
        .To = "Paba matthew"
        .Send
    End With
    Application.ScreenUpdating = False
End Sub


cheers

Matthew

Dear Matthew

Thank you for your help
How I can I make this to chose the relevant person to send the email?
Currently it sends the email to a pre defined person (To = "Paba matthew")

Thanks

I presume the recipient's email address is located in one of the columns of data?

if so, use this...

I have assumed that the email address is located in column1 of the data. I f this assumption is wrong just shout.

Sub sendemail()

Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer
Dim myRecipient As String

    Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate

    myRow = ActiveCell.Row
    ActiveSheet.Range("A" & myRow).Select

    Application.ScreenUpdating = False

    For myLoop = 1 To 255
        If ActiveCell.Value = "" Then myBodyText = myBodyText & "" & ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
        If ActiveCell.Column = 1 Then myRecipient = ActiveCell.Value
        If ActiveCell.Column = 256 Then myBodyText = myBodyText Else ActiveCell.Offset(0, 1).Select
    Next
    myBodyText = myBodyText & " " & ActiveCell.Value

    Set OutlookApp = CreateObject("Outlook.Application")
     With OutlookApp.CreateItem(olMailItem)
        .Subject = "My Subject Line"
        .Body = myBodyText
        .To = myRecipient
        .Send
    End With
    Application.ScreenUpdating = False
End Sub


Cheers

Matthew

Dear Matthew

Thank you for your help
It works partially
1. It sends only one email only to the first person on the list or to the person the curser stands on
2. It sends the email even if the Action Item is "Done" and not "Over Due"

Once again thanks for your help

Danny

Give this a whirl...

Sub sendemail()

Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer
Dim myRecipient As String
Dim myFirstCellAdd
Dim myCounter As Integer

myCounter = 0
Range("A1").Select
    Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
Do Until ActiveCell.Address = myFirstCellAdd
    myCounter = myCounter + 1
    myCurrAdd = ActiveCell.Address
    If myCounter = 1 Then myFirstCellAdd = ActiveCell.Address
    myRow = ActiveCell.Row
    ActiveSheet.Range("A" & myRow).Select

    Application.ScreenUpdating = False

    For myLoop = 1 To 3
        If ActiveCell.Value = "" Then myBodyText = myBodyText & "" & ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
        If ActiveCell.Column = 1 Then myRecipient = ActiveCell.Value
        If ActiveCell.Column = 256 Then myBodyText = myBodyText Else ActiveCell.Offset(0, 1).Select
    Next
    ActiveSheet.Range(myCurrAdd).Select

    Set OutlookApp = CreateObject("Outlook.Application")
     With OutlookApp.CreateItem(olMailItem)
        .Subject = "My Subject Line"
        .Body = myBodyText
        .To = myRecipient
        .Send
    End With
    Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    Loop
    MsgBox (myCounter)
    Application.ScreenUpdating = False

End Sub



cheers

Matthew

ooops!

change the 'For myLoop = 1 To 3' to 'For myLoop = 1 To 255'

sorry,

M

Dear Matthew

The first problem is solved.
The remained problem is that it sends the email even if the Status column is not "Over Due"

Thanks in advance