E-mail body range from lastRow

Dogaru · Apr 19th 2020

Hello,

I have an issue with trying to insert multiple ranges into an email body. I have the conditions if a cell has a certain value the in sends an email also when it sends the mail it copies the data from last row and it inserts it into the email body , the weird thing is that when I run the sub from the script it works perfectly(picture "from script") BUT when I insert the data from the user form and meets the condition it only gets the data from the first 5 columns (picture "from userform"). If someone can help me I would be very grateful. Thank you in advance

Code

Dim xrg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.count > 1 Then Exit Sub
  Set xrg = Intersect(Range("e:e"), Target)
    If xrg Is Nothing Then Exit Sub
    If Target.Value = "Serious Near Miss" Then
    Call Mail_small_Text_Outlook
    End If
End Sub

Sub Mail_small_Text_Outlook()
    Dim lastRow As Long
    'lastRow = Range("A" & .Rows.count).End(xlUp).Row
    lastRow = ListObjects("Table2234").Range.Columns(1).Cells.Find("*", Searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xmailbody As String
    Dim strbody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    strbody = Cells(lastRow, 1).Value & "Shift" & vbNewLine & _
              Cells(lastRow, 2).Value & "Date" & vbNewLine & _
              Cells(lastRow, 3).Value & "Raised By" & vbNewLine & _
              Cells(lastRow, 4).Value & "Month" & vbNewLine & _
              Cells(lastRow, 5).Value & "Condition" & vbNewLine & _
              Cells(lastRow, 6).Value & "Opened/Closed" & vbNewLine & _
              Cells(lastRow, 7).Value & "Raised By" & vbNewLine & _
              Cells(lastRow, 8).Value & "Area" & vbNewLine & _
              Cells(lastRow, 9).Value & "Near Miss" & vbNewLine & _
              Cells(lastRow, 10).Value & "Action"
    xmailbody = strbody
    On Error Resume Next
    With xOutMail
        .to = "xxxx"
        .cc = "xxx"
        .BCC = ""
        .Subject = "Serious Near Miss"
        .Body = xmailbody
        .display   
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    
End Sub

Display More

**royUK** · Apr 20th 2020

You need to attach an example workbook

Dogaru · Apr 20th 2020

I have sorted the issue, the problem was that the condition that would trigger the module was on column 5 and I had another 5 columns after it , as soon as it met the condition it only added the cell values from the last row up to column 5 where the condition was met and did not added the rest of the last rows in the columns . In order the make it work I have delayed the macro to run for 5 second giving enough time to add data to populate the active sheet, now it works perfect , I have posted the working code maybe someone else has the same issue, I have used the following code:

Code

Option Explicit 
 
Sub sendmail()

Application.OnTime Now + TimeSerial(0, 0, 10), "Mail_small_Text_OutlookMail_small_Text_Outlook"

End Sub Option Explicit 

Sub Mail_small_Text_OutlookMail_small_Text_Outlook()

 Dim lastRow As Long
 'lastRow = Range("A" & .Rows.count).End(xlUp).Row
 lastRow = ListObjects("Table2234").Range.Columns(1).Cells.Find("*", Searchorder:=xlByRows, searchdirection:=xlPrevious).Row
 Dim xOutApp As Object
 Dim xOutMail As Object
 Dim xmailbody As String
 Dim strbody As String
 Set xOutApp = CreateObject("Outlook.Application")
 Set xOutMail = xOutApp.CreateItem(0)
 strbody = Cells(lastRow, 1).Value & "Shift" & vbNewLine & _
 Cells(lastRow, 2).Value & "Date" & vbNewLine & _
 Cells(lastRow, 3).Value & "Raised By" & vbNewLine & _
 Cells(lastRow, 4).Value & "Month" & vbNewLine & _
 Cells(lastRow, 5).Value & "Condition" & vbNewLine & _
 Cells(lastRow, 6).Value & "Opened/Closed" & vbNewLine & _
 Cells(lastRow, 7).Value & "Raised By" & vbNewLine & _
 Cells(lastRow, 8).Value & "Area" & vbNewLine & _
 Cells(lastRow, 9).Value & "Near Miss" & vbNewLine & _
 Cells(lastRow, 10).Value & "Action"
 xmailbody = strbody
 On Error Resume Next
 With xOutMail
 .to = "xxxx"
 .cc = "xxx"
 .BCC = ""
 .Subject = "Serious Near Miss"
 .Body = xmailbody
 .display 
 End With
 On Error GoTo 0
 Set xOutMail = Nothing
 Set xOutApp = Nothing
 
End Sub

Display More

Dogaru · Apr 20th 2020

Solved

**royUK** · Apr 20th 2020

Well done, and thanks for sharing the solution.

E-mail body range from lastRow

Participate now!

Share

Tags