Excel to Email - Email body from Excel cells

Hi, I am trying to get an email sent from excell having the destination reading from a range of cells and the body showing the row where the email being sent to is located. This is the code I have done so far, which runs but nothing ends up happening:

Sub Send_Email_4()
Dim edress As String
Dim subj As String
Dim total As String
Dim message As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim path As String
Dim lastrow As Integer
Dim x As Integer
Dim header As String
Dim header1 As String
Dim header2 As String
Dim header3 As String
Dim header4 As String
Dim header5 As String
Dim header6 As String
Dim header7 As String
Dim header8 As String
Dim data As String
Dim Data1 As String
Dim Data2 As String
Dim data3 As String
Dim data4 As String
Dim data5 As String
Dim data6 As String
Dim data7 As String
Dim data8 As String


x = 5

Do While Sheet1.Cells(x, 1)

Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.createitem(0)

edress = Sheet1.Cells(x, 1)

total = Sheetl.Cells(52, 10)

subj = Sheet1.Cells(x, 2)
header = Sheet1.Cells(4, 3)
header1 = Sheet1.Cells(4, 4)
header2 = Sheet1.Cells(4, 5)
header3 = Sheet1.Cells(4, 6)
header4 = Sheet1.Cells(4, 7)
header5 = Sheet1.Cells(4, 8)
header6 = Sheet1.Cells(4, 9)
header7 = Sheet1.Cells(4, 10)

data = Sheet1.Cells(x, 2)
Data1 = Sheet1.Cells(x, 4)
Data2 = Sheet1.Cells(x, 5)
data3 = Sheet1.Cells(x, 6)
data4 = Sheet1.Cells(x, 7)
data5 = Sheet1.Cells(x, 8)
data6 = Sheet1.Cells(x, 9)
data7 = Sheet1.Cells(x, 10)


outlookmailitem.To = edress
outlookmailitem.cc = ""
outlookmailitem.bcc = ""
outlookmailitem.Subject = subj
outlookmailitem.Body = "Dear NAFDA FS Member," & vbCrLf & _
"Results for the annual FYR 2021 growth program are as follows," & _
vbCrLf & header & " " & header1 & " " & header2 & " " & header3 & " " & header4 & " " & header5 & " " & header6 & " " & header7 & _
vbCrLf & data & " " & Data1 & " & data2 &" _
& data3 & " " & data4 & " " & data5 & _
data6 & " " & data7 & " " _
& vbCrLf & "Best Regards"

outlookmailitem.display

lastrow = lastrow + 1
EMAILS = ""

x = x + 1

Loop

End Sub