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