Column Headers to the last line of data entered to the HTMLBody - html

Question

I've included the last line of data entered to my HTML body. However the column headers are not showing, what am I doing wrong?
Private Sub cmdEmail_Click()
'Declare Outlook Variables
Dim OLApp As Outlook.Application
Dim OLMail As Object
Dim MyData As Object
'Open the Outlook Application and Start a new mail
Set OLApp = New Outlook.Application
Set OLMail = OLApp.CreateItem(0)
Set MyData = ThisWorkbook.Worksheets("Database").Cells(Rows.count, 1).End(xlUp).Resize(, 13)
OLApp.Session.Logon
With OLMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Quality Alert"
.HTMLBody = "<P><font size='6' face='Calibri' color='black'>Quality Issue Found<br><br> Please reply back with what adjustments have been made to correct this issue. </font></P>" & ConvertRangeToHTMLTable(ThisWorkbook.Worksheets("Database").Cells(Rows.count, 1).End(xlUp).Resize(, 13))
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Database")
Dim wb As Workbook
ws.Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\Temp\Database.xlsx" 'Change Path
.Display
' .Send
wb.Close SaveChanges:=False
Kill "C:\Temp\Database.xlsx"
End With
'Clearing Memory
Set OLMail = Nothing
Set OLApp = Nothing
End Sub

Answer 1

Only the 1st 13 columns of the last row are being targeted.
ThisWorkbook.Worksheets("Database").Cells(Rows.count, 1).End(xlUp).Resize(, 13)
I order to include all the data, you'll have to extend the range from the first cell to the last row.
With ThisWorkbook.Worksheets("Database")
Set MyData = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp).Resize(, 13))
End With
Breaking up the code into smaller bites will allow you to easily isolate and test your code.
Extracting the code that targets the data range into its own function (in a public module) allows use Application.Goto to visibly inspect the range.
Application.Goto EmailData
Private Sub cmdEmail_Click()
Dim HTMLBody As String
HTMLBody = EmailHTMLFirstAndLastRow
SendEmail HTMLBody
CreateACopyOfTheDatabaseSaveItCloseKillItButNeverDoAnythingWithit
End Sub
Place this code in a public module:
Sub SendEmail(HTMLBody As String)
'Declare Outlook Variables
Dim OLApp As Outlook.Application
Dim OLMail As Object
Dim MyData As Object
'Open the Outlook Application and Start a new mail
Set OLApp = New Outlook.Application
Set OLMail = OLApp.CreateItem(0)
OLApp.Session.Logon
With OLMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Quality Alert"
.HTMLBody = "<P><font size='6' face='Calibri' color='black'>Quality Issue Found<br><br> Please reply back with what adjustments have been made to correct this issue. </font></P>" & HTMLBody
.Display
' .Send
End With
'Clearing Memory
Set OLMail = Nothing
Set OLApp = Nothing
End Sub
Function EmailHTMLFirstAndLastRow() As String
Dim Target As Range
Set Target = EmailData
With Target
.EntireRow.Hidden = msoTrue
.Rows(1).Hidden = msoFalse
.Rows(.Rows.Count).Hidden = msoFalse
.EntireRow.Hidden = msoFalse
End With
EmailHTMLFirstAndLastRow = RangetoHTML(Target.Rows(Target.Rows.Count))
End Function
Function EmailData() As Range
With ThisWorkbook.Worksheets("Database")
Set EmailData = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp).Resize(, 13))
End With
End Function
Sub CreateACopyOfTheDatabaseSaveItCloseKillItButNeverDoAnythingWithit()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Database")
Dim wb As Workbook
ws.Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\Temp\Database.xlsx" 'Change Path
wb.Close SaveChanges:=False
Kill "C:\Temp\Database.xlsx"
End Sub
Edit
I edited the code to create html for only the header and last rows, as per the OP's request. Since RangetoHTML() ignores hidden rows, I define the range of data, hid all but the fist and last rows, the passed the range to RangetoHTML() and assigned its value to a variable, the unhid the range.