email help with adding content

[SQUIDD]

Hi All

So trying to create an email, see code below, in particular the red text.

I have data in columns N,O,P. but this can vary each time from 1 row to 30 rows. My example below showing 5 rows.

What im wondering is if somehow i can loop, however many rows there happen to be per macro run.

instead of having to write a long code and presumably end up with my signature way down the email after a large gap.

hope that makes sense?

Sub mail_me()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "HI " & vbNewLine & vbNewLine & _
              "PLEASE QUOTE ON THE BELOW, ALL IN BRASS " & vbNewLine & vbNewLine
                
[COLOR=#ff0000]                LINE1 = Range("'METAL'!N2") & " X " & Range("'METAL'!O2") & " OFF @ " & Range("'METAL'!P2") & "MM" & vbNewLine
                LINE2 = Range("'METAL'!N3") & " X " & Range("'METAL'!O3") & " OFF @ " & Range("'METAL'!P3") & "MM" & vbNewLine
                LINE3 = Range("'METAL'!N4") & " X " & Range("'METAL'!O4") & " OFF @ " & Range("'METAL'!P4") & "MM" & vbNewLine
                LINE4 = Range("'METAL'!N5") & " X " & Range("'METAL'!O5") & " OFF @ " & Range("'METAL'!P5") & "MM" & vbNewLine
                LINE5 = Range("'METAL'!N6") & " X " & Range("'METAL'!O6") & " OFF @ " & Range("'METAL'!P6") & "MM" & vbNewLine[/COLOR]
             
            

    On Error Resume Next
    With OutMail
        .TO = ""
        .CC = ""
        .BCC = ""
        .Subject = Range("'APP'!AA4") & " " & Range("'APP'!AA1")
        .Body = strbody &[COLOR=#ff0000] LINE1 & LINE2 & LINE3 & LINE4 & LINE5 & LINE6[/COLOR]
        .DISPLAY
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

 

[jimrward]

How do you know how many lines you might have do you have a counter in a cell or keep going until a blank entry or customer name changes

You could loop from 1-30 and ignore blanks

 

[SQUIDD]

Hi Jim

exactly, i would probably use the below in a loop to determine the lastrow of data.
But yes, it would be upon 1st blank row, once the data ends, i have no blank rows in between.

lr = Range("'metal'!A" & Rows.Count).End(xlUp).Row

thanks

dave

 

[jimrward]

something like, assuming data starts on row 2, change k to 1 if it doesnt

Sub mail_me()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "HI " & vbNewLine & vbNewLine & _
              "PLEASE QUOTE ON THE BELOW, ALL IN BRASS " & vbNewLine & vbNewLine
                
    k = 2
    
    Do While Range("'METAL'!N" & k) <> ""
            strbody = strbody & Range("'METAL'!N" & k) & " X " & Range("'METAL'!O" & k) & " OFF @ " & Range("'METAL'!P" & k) & "MM" & vbNewLine
            k = k + 1
    Wend
    
        On Error Resume Next
    With OutMail
        .TO = ""
        .CC = ""
        .BCC = ""
        .Subject = Range("'APP'!AA4") & " " & Range("'APP'!AA1")
        .Body = strbody
        .DISPLAY
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

 

[SQUIDD]

Hi Jim

That worked perfectly thanks so much for your time.

I did however have to change "DO WHILE" to just "WHILE"

thanks again

Dave

 

[jimrward]

No problem I was doing it from iPad