1 Attachment(s)
loop through and copy non empty cell values to email body with each headers
Dear Experts,
Request your help with the following
The range "L11:L83" has 8 different headings in column A. How the following code can be modified to capture headings before each set of observations? Also I need to attach a copy of the worksheet to the email
The email body should be like below-
Petty Cash
Observation 1
Observation 10
Revenue Management
Observation 2
Observation 20
Observation 21
and so on...
Thanks in advance for your help
Code:
Sub EmailObs()
Dim wsVR As Worksheet
Dim obs As Variant
Dim cell As Range
Dim xOutlookObj As Object
Dim xEmailObj As Object
Set wsVR = ThisWorkbook.Worksheets("Visit Checklist")
For Each cell In wsVR.Range("L11:L83")
If Not IsEmpty(cell) Then
obs = obs & vbNewLine & cell.Value
End If
Next cell
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
'.To =
'.CC =
.Subject = "test"
.Body = obs
'.Send
End With
End Sub