I managed to create the codes. Thanks again rollis for the link which was very helpful to prepare the codes

Sub DraftEmail()


    Dim wsVR   As Worksheet
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim wbVR   As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim StrBody As String
    Dim Obs    As String
    Dim Cell   As Range
    Dim SRating As String
    Dim MakeJPG As String


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    
    Set wbVR = ThisWorkbook
    Set wsVR = wbVR.Worksheets("Visit Checklist")
    wsVR.Copy
    Set Destwb = ActiveWorkbook
    
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            FileExtStr = ".xlsx": FileFormatNum = 51
        End If
    End With
    
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Visit Checklist - store " & wsVR.Range("D5").Value
    
    Select Case wsVR.Range("X20").Value
        Case Is < 0.7
            SRating = "Red"
        Case Is > 0.85
            SRating = "Green"
        Case Else
            SRating = "Amber"
    End Select
    
    If wsVR.Range("K83").Value = "No" Then SRating = "Red"
    
    StrBody = "Dear " & wsVR.Range("G6").Value & "," & "<br>" & _
              "We conducted a detailed LP review of " & wsVR.Range("D4").Value & " Store (" & wsVR.Range("D5").Value & ") " & _
              "as on " & Format(wsVR.Range("D7").Value, "DD-MMM-YYYY") & ". " & "Based on the observations, the store is categorized as " & SRating & "." & "<br>" & _
              "Please find the summary below and request your action plans and corrective measures within three working days." & "<br>" & "</br></br></br>"
    Obs = "Important observations noted are as follows-" & "<br>" & "</br>"
    
    'Create JPG file of the range
    'Only enter the Sheet name and the range address
    MakeJPG = CopyRangeToJPG("Visit Checklist", "P10:X24")
    
    Dim flag   As Boolean                         '<- added
    Dim header   As String                        '<- added
    For Each Cell In wsVR.Range("L11:L83")
        If Not IsEmpty(Cell) Then
            If header <> Cell.Offset(0, -11).MergeArea.Cells(1, 1) Then flag = False 'detect if headerer has changed (new section) then reset flag
            If flag = False Then                  'detect if headerer has already been added to obs
                Obs = Obs & "<br><b><u>" & Cell.Offset(0, -11).MergeArea.Cells(1, 1) & ":</b></u>" 'add headerer to obs
                header = Cell.Offset(0, -11).MergeArea.Cells(1, 1) 'store headerer
                flag = True                       'set flag for headerer already added to obs
            End If
            Obs = Obs & "<br>" & Cell.Value & "</br>"
        End If
    Next Cell
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            '.to =
            .CC = "anishms@msn.com"
            .Subject = "LP Review | Store" & wsVR.Range("D5").Value & " (" & wsVR.Range("D4").Value & ") " & wsVR.Range("D7").Value
            .Attachments.Add Destwb.FullName
            .Attachments.Add MakeJPG, 1, 0
            .HTMLBody = "<html><p>" & StrBody & "</p><img src=""cid:NamePicture.jpg"" width=616.5 height=275.25><p>" & Obs & "</p></html>"
            .Display
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With
    
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    Kill MakeJPG
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub


Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
    Dim PictureRange As Range


    With ThisWorkbook
        On Error Resume Next
        .Worksheets(NameWorksheet).Activate
        Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
        
        If PictureRange Is Nothing Then
            MsgBox "Sorry this is not a correct range"
            On Error GoTo 0
            Exit Function
        End If
        
        PictureRange.CopyPicture
        With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
        End With
        .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
    End With
    
    CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
    Set PictureRange = Nothing
End Function