(Solved) – VBA code to lookup value in range and return cell across value

(solved)-–-vba-code-to-lookup-value-in-range-and-return-cell-across-value

I am hoping someone could help me out with a line of code that I can not figure out. VBA coding is not my strong point and have been spent at least 2 hours trying to read up and test code. The workbook that this code is from will auto email the addresses in column M. It then pulls in data from other cells in that row that are used in the subject line and body. Where I am having an issue is the value that will be in Column H of the row. That value that will be in that cell is a users ID. That user ID can be found in Range(“A2:A18”) of the Users worksheet. The users email address, which is the value I am looking for, is located in Range(“B2:B18”) of that same sheet. The excerpt from the code below that this applies to is “Please email your closeout documents to: ” & Cells(cell.Row, “H”).Value”

Any help is greatly appreciated right now.

Private Sub CommandButton1_Click()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("M").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "A").Value) = "yes" _
       And LCase(Cells(cell.Row, "A").Value) <> "Sent" Then

        Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next
        With OutMail
            .To = cell.Value
            .Subject = Cells(cell.Row, "AD").Value
            .Body = "Dear " & Cells(cell.Row, "AC").Value & "," & vbNewLine & vbNewLine & strbody & _
            "Your closeout package for " & Cells(cell.Row, "C").Value & "https://stackoverflow.com/" & Cells(cell.Row, "D").Value & "https://stackoverflow.com/" & Cells(cell.Row, "E").Value & "https://stackoverflow.com/" & Cells(cell.Row, "F").Value & " is over 30 days past due." & vbNewLine & _
            "All closeout requirements are attached for your reference and due within 10 days of construction complete. Please email your closeout documents to: " & Cells(cell.Row, "H").Value & _
            "• Scheduled Construction Start Date - " & Cells(cell.Row, "X").Value & vbNewLine & _
            "• Construction Start Date - " & Cells(cell.Row, "V").Value & vbNewLine & _
            "• Construction Completed Date- " & Cells(cell.Row, "W").Value & vbNewLine & vbNewLine & _
            "• General Contractor - " & Cells(cell.Row, "N").Value & vbNewLine & _
            "• GC Name - " & Cells(cell.Row, "O").Value & vbNewLine & _
            "• GC Phone Number - " & Cells(cell.Row, "P").Value & vbNewLine & _
            "• GC Email - " & Cells(cell.Row, "Q").Value & vbNewLine & vbNewLine & _
            "• Company - " & Cells(cell.Row, "J").Value & vbNewLine & _
            "• Name - " & Cells(cell.Row, "K").Value & vbNewLine & _
            "• Phone Number - " & Cells(cell.Row, "L").Value & vbNewLine & _
            "• Email - " & Cells(cell.Row, "M").Value & vbNewLine & vbNewLine

            .Send
        End With
        On Error GoTo 0
        Cells(cell.Row, "A").Value = "Sent"
        Set OutMail = Nothing
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *