Extract Non-Blank Cells & copy row into a email

[mikey141]

Reminder Emails via Outlook
I'm new at this and been looking around for ages to get the right code and wondered if someone can help please?

I have a sheet that I've setup to auto send a email when column "M" has the word "Reminder" inserted by another VBA command. What I want to do is copy multiple rows into the body of email if the word "Reminder" or non-blank is located in column (M3:M500)

I.E.
If "Reminder" in range (M3:M500) Then copy (B8:K8)

Below is the code for sending the basic email
Sub SendReminderMail()
Dim OutlookApp As Object
Dim OutLookMailItem As Object
Dim icounter As Integer
Dim MailDest As String




Set OutlookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutlookApp.CreateItem(0)


With OutLookMailItem
MailDest = ""
For icounter = 1 To WorksheetFunction.CountA(Columns(14))
If MailDest = "" And Cells(icounter, 14).Offset(0, -1) = "Reminder" Then
MailDest = Cells(icounter, 14).Value
ElseIf MailDest <> "" And Cells(icounter, 14).Offset(0, -1) = "Reminder" Then
MailDest = MailDest & ";" & Cells(icounter, 14).Value
End If
Next icounter


.To = MailDest
.Subject = "Risk Assessment Reminder" & Cells(icounter, 2)
.Body = "Reminder of your next Risk Assessment"
.Display
'.Send
End With


Set OutLookMailItem = Nothing
Set OutlookApp = Nothing
End Sub