Email macro - Attach rows to Email body - Based on entered value

[cagni]

Hi

I have an excel spreadsheet which is used as an ordering sheet. The workbook contains 4-5 sheets with data as the attached image below.

The plan is to have Button on sheet1 and when pressed a macro will copy the rows from each sheet where a value is entered in F column to the email body. Is this even possible to create?

If not I guess I should just make the macro so i creates a pdf of all rows and then send that to the email. Would it then be possible to create the pdf data from different sheets into 1, or should it be several pdfs?

I haven´t started any code yet as I´m not sure which method to go with.

If missing information let me know, and I will answer.

 

[bferraz]

Hey, can you try the following code? If you have any problems with it let me know.

Sub SendEmail()

Dim ws As Worksheet
Dim lastRow As Long
Dim emailBody As String

'Loop through each sheet in the workbook
For Each ws In ThisWorkbook.Sheets
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row 'Find last row with data in column F
    If lastRow > 3 Then 'Check if there is any data in the sheet
        'Loop through each row with data in column F
        For i = 4 To lastRow
            If ws.Cells(i, "F").Value <> "" Then 'Check if there is a value in column F
                emailBody = emailBody & ws.Range("F" & i).Value & vbNewLine 'concatenate the rows value from each sheet to the email body
            End If
        Next i
    End If
Next ws

'Create and send the email
Dim OutlookApp As Object
Dim MItem As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set MItem = OutlookApp.CreateItem(0)
With MItem
    .To = "" 'here is the email that should receive it
    .Subject = "" 'here is the subject
    .Body = emailBody
    .Send 'if you don't want it to send the email automatically and you want to review it, comment this line and uncomment the next
    '.Display
End With

Set MItem = Nothing
Set OutlookApp = Nothing

End Sub

 

[cagni]

Hey, can you try the following code? If you have any problems with it let me know.

Sub SendEmail()

Dim ws As Worksheet
Dim lastRow As Long
Dim emailBody As String

'Loop through each sheet in the workbook
For Each ws In ThisWorkbook.Sheets
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row 'Find last row with data in column F
    If lastRow > 3 Then 'Check if there is any data in the sheet
        'Loop through each row with data in column F
        For i = 4 To lastRow
            If ws.Cells(i, "F").Value <> "" Then 'Check if there is a value in column F
                emailBody = emailBody & ws.Range("F" & i).Value & vbNewLine 'concatenate the rows value from each sheet to the email body
            End If
        Next i
    End If
Next ws

'Create and send the email
Dim OutlookApp As Object
Dim MItem As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set MItem = OutlookApp.CreateItem(0)
With MItem
    .To = "" 'here is the email that should receive it
    .Subject = "" 'here is the subject
    .Body = emailBody
    .Send 'if you don't want it to send the email automatically and you want to review it, comment this line and uncomment the next
    '.Display
End With

Set MItem = Nothing
Set OutlookApp = Nothing

End Sub

Hi bferraz

It does find the number that has been entered in column F and copy it into the email. But I wanted it to copy the hole line into the email, I might not have written this.

The hole line needs to be copied so we are able to see what should be ordered. Now we only get the number that is typed in the column F.

Otherwise everything works.

 

[cagni]

Hi bferraz

It does find the number that has been entered in column F and copy it into the email. But I wanted it to copy the hole line into the email, I might not have written this.

The hole line needs to be copied so we are able to see what should be ordered. Now we only get the number that is typed in the column F.

Otherwise everything works.

What I would like to see is basically this in the email:

 

[bferraz]

Try this one out.

Sub SendEmail()

Dim ws As Worksheet
Dim lastRow As Long
Dim emailBody As String

emailBody = "Item number" & " | " & "Profil number" & " | " & "Item description" & " | " & "Size" & " | " & "Min. order" & " | " & "Order" & vbNewLine

'Loop through each sheet in the workbook
For Each ws In ThisWorkbook.Sheets
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row 'Find last row with data in column F
    If lastRow > 3 Then 'Check if there is any data in the sheet
        'Loop through each row with data in column F
        For i = 4 To lastRow
            If ws.Cells(i, "F").Value <> "" Then 'Check if there is a value in column F
                emailBody = emailBody & ws.Range("A" & i).Value & " | " & ws.Range("B" & i).Value & " | " & ws.Range("C" & i).Value & " | " & ws.Range("D" & i).Value & " | " & ws.Range("E" & i).Value & " | " & ws.Range("F" & i).Value & vbNewLine 'concatenate the rows value from each sheet to the email body
            End If
        Next i
    End If
Next ws

'Create and send the email
Dim OutlookApp As Object
Dim MItem As Object
Dim wdDoc As Word.Document
Set OutlookApp = CreateObject("Outlook.Application")
Set MItem = OutlookApp.CreateItem(0)
Set wdDoc = MItem.GetInspector.WordEditor
With MItem
    .To = "" 'here is the email that should receive it
    .Subject = "" 'here is the subject
    wdDoc.Range.Text = emailBody
    wdDoc.Range.ConvertToTable Separator:="|", AutoFit:=True, _
      Format:=wdTableFormatList5, AutoFitBehavior:=wdAutoFitContent
    '.Send 'if you don't want it to send the email automatically and you want to review it, comment this line and uncomment the next
    .Display
End With

Set MItem = Nothing
Set OutlookApp = Nothing
Set wdDoc = Nothing

End Sub

 

[cagni]

Try this one out.

Sub SendEmail()

Dim ws As Worksheet
Dim lastRow As Long
Dim emailBody As String

emailBody = "Item number" & " | " & "Profil number" & " | " & "Item description" & " | " & "Size" & " | " & "Min. order" & " | " & "Order" & vbNewLine

'Loop through each sheet in the workbook
For Each ws In ThisWorkbook.Sheets
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row 'Find last row with data in column F
    If lastRow > 3 Then 'Check if there is any data in the sheet
        'Loop through each row with data in column F
        For i = 4 To lastRow
            If ws.Cells(i, "F").Value <> "" Then 'Check if there is a value in column F
                emailBody = emailBody & ws.Range("A" & i).Value & " | " & ws.Range("B" & i).Value & " | " & ws.Range("C" & i).Value & " | " & ws.Range("D" & i).Value & " | " & ws.Range("E" & i).Value & " | " & ws.Range("F" & i).Value & vbNewLine 'concatenate the rows value from each sheet to the email body
            End If
        Next i
    End If
Next ws

'Create and send the email
Dim OutlookApp As Object
Dim MItem As Object
Dim wdDoc As Word.Document
Set OutlookApp = CreateObject("Outlook.Application")
Set MItem = OutlookApp.CreateItem(0)
Set wdDoc = MItem.GetInspector.WordEditor
With MItem
    .To = "" 'here is the email that should receive it
    .Subject = "" 'here is the subject
    wdDoc.Range.Text = emailBody
    wdDoc.Range.ConvertToTable Separator:="|", AutoFit:=True, _
      Format:=wdTableFormatList5, AutoFitBehavior:=wdAutoFitContent
    '.Send 'if you don't want it to send the email automatically and you want to review it, comment this line and uncomment the next
    .Display
End With

Set MItem = Nothing
Set OutlookApp = Nothing
Set wdDoc = Nothing

End Sub

I get this errror :

 

[bferraz]

Please, add Microsoft Word Reference.
Tools -> References -> Microsoft Word

 

[cagni]

Please, add Microsoft Word Reference.
Tools -> References -> Microsoft Word

View attachment 83665

Super thank you so much, this works like a charm

 

[bferraz]

You are welcome! =)

 

[cagni]

Actually would it be possible to add text to the emailBody, for example just a short message? Before and after the word doc?

If adding .Body = "Best Regards" it just delete the word doc that is attached.

This is not a show stopper, and is just a nice to have.