How Can I get this functionality for all rows short of coding it for each instance?

[franswa3434]

Hey all,

I created a script that will auto-generate an email in outlook based upon a cell value in a row, and will populate the email based upon information in that same row.

Long story short, I would like to be able to apply this to all rows, or at least to a defined set, and if possible, all without having to script it for each row.

Help?

Thank you all for your help!

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim xRg As Range
    
    On Error Resume Next
    If ActiveSheet.Range("J2") = "Waiting for Response From Carrier" Then
    Call Mail_small_Text_Outlook
    
    End If
    
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
        xMailBody = "Hello," & vbNewLine & vbNewLine & _
              "Would you please provide me a quote for the following address:" & vbNewLine & vbNewLine & _
              "Address: " & ActiveSheet.Range("F2") & ", " & ActiveSheet.Range("G2") & ", " & ActiveSheet.Range("H2") & " " & ActiveSheet.Range("I2") & vbNewLine & _
              "Service: " & ActiveSheet.Range("C2") & "Mb/" & ActiveSheet.Range("D2") & "Mb - " & ActiveSheet.Range("E2") & vbNewLine & vbNewLine & _
              "Thank you,"
  
    On Error Resume Next
    With xOutMail
        .SentOnBehalfOfName = "xxxxxxx@xxxxxxx.com"
        .To = ActiveSheet.Range("N2")
        .CC = ActiveSheet.Range("P2") & ";xxxxxxx@xxxxxxx.com;xxxxxxx@xxxxxxx.com"
        .BCC = ""
        .Subject = "Service Request - CW: " & ActiveSheet.Range("B2") & " - " & ActiveSheet.Range("F2") & ", " & ActiveSheet.Range("G2") & ", " & ActiveSheet.Range("H2") & " " & ActiveSheet.Range("I2")
        .Body = xMailBody
        .Display   'or use .Send
        
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

 

[Leith Ross]

Hello franswa3434,

Try this adaptation of your macros.

Private Sub Worksheet_Change(ByVal Target As Range)


        ' The cell being changed must be in column "J" and the row must be 2 or greater.
        If Target.Column <> 10 Then Exit Sub
        If Target.row = 1 Then Exit Sub
        
        If Target = "Waiting for Response From Carrier" Then
            Call Mail_small_Text_Outlook(Target.row)
        End If
    
End Sub


Sub Mail_small_Text_Outlook(ByVal row As Long)


    Dim xOutApp     As Object
    Dim xOutMail    As Object
    Dim xMailBody   As String
    
        Set xOutApp = CreateObject("Outlook.Application")
        Set xOutMail = xOutApp.CreateItem(0)
        
        xMailBody = "Hello," & vbNewLine & vbNewLine & _
              "Would you please provide me a quote for the following address:" & vbNewLine & vbNewLine & _
              "Address: " & Cells(row, "F") & ", " & Cells(row, "G") & ", " & Cells(row, "H") & " " & Cells(row, "I") & vbNewLine & _
              "Service: " & Cells(row, "C") & "Mb/" & Cells(row, "D") & "Mb - " & Cells(row, "E") & vbNewLine & vbNewLine & _
              "Thank you,"
  
        With xOutMail
            .SentOnBehalfOfName = "xxxxxxx@xxxxxxx.com"
            .To = Cells(row, "N")
            .CC = Cells(row, "P") & ";xxxxxxx@xxxxxxx.com;xxxxxxx@xxxxxxx.com"
            .BCC = ""
            .Subject = "Service Request - CW: " & Cells(row, "B") _
                    & " - " & Cells(row, "F") _
                    & ", " & Cells(row, "G") _
                    & ", " & Cells(row, "H") _
                    & " " & Cells(row, "I")
            .Body = xMailBody
            .Display   'or use .Send
        End With
    
        Set xOutMail = Nothing
        Set xOutApp = Nothing
    
End Sub

 

[franswa3434]

Yup, that is exactly what i need!

Thanks Leith, i really appreciate it!

 

[Leith Ross]

Hello franswa3434,

You're welcome. Glad I could help.