Email Body Loop Values - excel

Question

I am attempting to loop through a column (n=96) in my worksheet, when it comes across a value <10 I would like the macro to open outlook and email offset values (four columns across) from the values it found.
I've generated a working example though it seems to be limited to only one example I've tested. I think I am approaching it from the wrong angle.
Sub SendReminderMail()
Dim p As Long
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
'If MsgBox("Are you sure?", vbYesNo) = vbNo Then Exit Sub
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
p = 2
Do Until Trim$(Cells(p, 1).Value) = ""
If Cells(p, 1).Value <= 10 Then
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.To = "Emailaddress etc"
.Subject = "Reminder: " & Cells(1, 7).Value
.Body = Cells(p, 1).Offset(0, 4).Value
.Display
End With
End If
p = p + 1
Loop
End Sub
How do I set it up to loop through all the <10 values and tell it to paste the offset values into the body of the email?

Answer 1

I think that you need to split this into two blocks of code.
First block would iterate through rows, check criteria and, if needed, call the second one, so the mail sending Sub, passing by necessary parameters.
Someting similar to the below code:
Sub SendReminderMail(ByVal MailSubject As String, mailBody As String)
Dim p As Long
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
'If MsgBox("Are you sure?", vbYesNo) = vbNo Then Exit Sub
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.To = "Emailaddress etc"
.Subject = MailSubject
.Body = mailBody
.Display
End With
End Sub
Sub IterateThroughRows()
Dim p As Integer
Dim Sht As Worksheet
Dim MailSubject As String
Dim mailBody As String
Set Sht = ThisWorkbook.Sheets("SheetName")
p = 2
Do Until Sht.Cells(p, 1).Value = ""
If Cells(p, 1).Value <= 10 Then
mailBody = mailBody + " | " + Sht.Cells(p, 1).Offset(0, 4).Value
End If
p = p + 1
Loop
Call SendReminderMail(MailSubject, mailBody)
MailSubject = "Reminder: " & Sht.Cells(1, 7).Value
End Sub