Macro to have excel take certain cells and make them an email.

[Brooksie201]

I have been trying to look through some of the forums on here to extract information from Excel and put it into an email. I have made a few attempts and tried modifying VBA code I saw on this forum to fit my needs but I have had no luck.

What I have is a list that will be filled over the course of time with Technical Queries. I want to be able to hit a "SEND" button and have the Excel Generate an email for that specific Query. I have already done the CONCATENATE work within the Excel file, so all it needs to do is take the information in Columns N, O, & P and stick those in an email.

I have set Column N to be the Subject, Column O to be the To (i.e. email address) and Column P to be the Body of the email. If I can add the functionality to ASK if there is an attachment needed that would be great too. The issue is that this list will be filled over time, and I don't want the email to send the whole list, every time, I just want it to send an email for a specific Technical Query. So maybe that means some type of BOX where a person can enter the the TQ number to do this?? Also, I don't want it to send an email if there is a Response, or reponse Date logged, and if the days overdue is > 3 I want to set the email to high importance.

No. Area Item Affected Tech Query / Observation Required by Date Resource Client Response Response Date Status Days Overdue Result of Response Subject To Body 1 Reactor EM Class TEST TEST TEST 12/12/2014 Jim Bob John Doe Technical Query TQ-JJ-1-R john.doe@1234.com John Doe, Please find the Technical Query TQ-JJ-1-R for Reactor in regards to EM Class and TEST TEST TEST. We require a response by Dec-12-14. Thanks, Jim Bob 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 <tbody> </tbody>

<tbody>
</tbody>

I have been messing with this code at the moment, but I have just been trying to modify something that was already on this forum. Any help is appreciated.

Sub MailTQ()'
' MailTQ Macro
s1 = "Tech Queries"
Sheets(s1).Select
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal


n = 1
Do Until Cells(n, 2) = ""
    If Cells(n, 8) <> "" Then
        GoTo 100
    Else
        PAX = Cells(n, 1)
        PAXS = Left(PAX, InStr(PAX, "/") - 1)
        PAXF = Mid(PAX, InStr(PAX, "/") + 1, Len(PAX) - InStr(PAX, "/"))
        Z = Application.WorksheetFunction.Match(PAX, Sheets(s1).Range(Cells(n, 1), Cells(xx - 2, 1)), 1)
        y = n
        x = 1
        BODY1 = ""
        Do Until y > ((n + Z) - 1)
            BODY1 = BODY1 & vbLf & vbLf & _
                "Technical Queries " & x & vbLf & vbLf & _
                "TQ No.: " & Cells(y, 19) & vbLf & _
                "Request: " & Cells(y, 20) & vbLf & _
                 Cells(y, 6) = "DONE"
            x = x + 1
            y = y + 1
        Loop
        
        Set aOutlook = GetObject(, "Outlook.Application")
        If aOutlook Is Nothing Then Set aOutlook = New Outlook.Application
        Set aEmail = aOutlook.CreateItem(olMailItem)
        'set Importance
        aEmail.Importance = olImportanceHigh
        'Set Subject
        aEmail.Subject = "J&J Technical Query " & Format(Now(), "DD-MM-YYYY")
        'Set Line 1 of Body - Greeting
        aEmail.Body = PAXF & " " & PAXS & ", " & vbLf & vbLf & _
                "Please find below the details of a new Technical Query " & _
                "we await your response." & BODY1
        'Set Recipient
        aEmail.Recipients.Add Cells(n, 25)
        'Send Mail
        aEmail.Send
        
    End If
100
n = n + 1
Loop


Range(Cells(1, 25), Cells(65536, 25)).ClearContents


End Sub