+----------------+---------------------+---------+
|     Email      |     Application     | Version |
+----------------+---------------------+---------+
| test1@test.com | Microsoft_Office_13 | v2.0    |
| test1@test.com | Putty               | v3.0    |
| test1@test.com | Notepad             | v5.6    |
| test2@test.com | Microsoft_Office_13 | v2.0    |
| test2@test.com | Putty               | v3.0    |
| test2@test.com | Adobe_Reader        | v6.4    |
| test3@test.com | Microsoft_Office_13 | v3.6    |
| test3@test.com | Paint               | v6.4    |
| test3@test.com | Adobe_Reader        | v6.4    |
+----------------+---------------------+---------+

+----------------+---------------------+---------+
|     Email      |     Application     | Version |
+----------------+---------------------+---------+
| test2@test.com | Microsoft_Office_13 | v2.0    |
| test2@test.com | Putty               | v3.0    |
| test2@test.com | Adobe_Reader        | v6.4    |
+----------------+---------------------+---------+

+----------------+---------------------+---------+
|     Email      |     Application     | Version |
+----------------+---------------------+---------+
| test2@test.com | Microsoft_Office_13 | v2.0    |
| test2@test.com | Putty               | v3.0    |
| test2@test.com | Adobe_Reader        | v6.4    |
+----------------+---------------------+---------+

Option Explicit


Sub Test1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim dict As Object 'keep the unique list of emails
    Dim cell As Range
    Dim cell2 As Range
    Dim rng As Range
    Dim i As Long
    Dim WS As Worksheet

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    Set dict = CreateObject("scripting.dictionary")
    Set WS = ThisWorkbook.Sheets("Sheet1") 'change the name of the sheet accordingly

    On Error GoTo cleanup
    For Each cell In WS.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then

            'check if this email address has been used to generate an outlook email or not
            If dict.exists(cell.Value) = False Then

                dict.Add cell.Value, "" 'add the new email address
                Set OutMail = OutApp.CreateItem(0)
                Set rng = WS.UsedRange.Rows(1)

                'find all of the rows with the same email and add it to the range
                For Each cell2 In WS.UsedRange.Columns(1).Cells
                    If cell2.Value = cell.Value Then
                        Set rng = Application.Union(rng, WS.UsedRange.Rows(cell2.Row))
                    End If
                Next cell2

                On Error Resume Next
                With OutMail
                    .To = cell.Value
                    .Subject = "Reminder"
                    .HTMLBody = "Hi, please find your account permissions below:" & vbNewLine & vbNewLine & RangetoHTML(rng)
                    .Display
                End With

                On Error GoTo 0
                Set OutMail = Nothing
            End If
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(rng As Range)
' coded by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Option Explicit

Public app As String
Public version As String

Option Explicit

Sub Consolidate()

#If Early Then
    Dim emailInformation As New Scripting.Dictionary
#Else
    Dim emailInformation As Object
    Set emailInformation = CreateObject("Scripting.Dictionary")
#End If

    GetEmailInformation emailInformation
    SendInfoEmail emailInformation
End Sub


Sub GetEmailInformation(emailInformation As Object)

Dim rg As Range
Dim sngRow As Range

Dim emailAddress As String
Dim myAppInfo As AppInfo
Dim AppInfos As Collection

Set rg = Range("A1").CurrentRegion    ' Assuming the list starts in A1 and DOES NOT contain empty row
Set rg = rg.Offset(1).Resize(rg.Rows.Count - 1)    ' Cut the headings

    For Each sngRow In rg.Rows

        emailAddress = sngRow.Cells(1, 1)

        Set myAppInfo = New AppInfo
        With myAppInfo
            .app = sngRow.Cells(1, 2)
            .version = sngRow.Cells(1, 3)
        End With

        If emailInformation.Exists(emailAddress) Then
            emailInformation.item(emailAddress).Add myAppInfo
        Else
            Set AppInfos = New Collection
            AppInfos.Add myAppInfo
            emailInformation.Add emailAddress, AppInfos
        End If

    Next

End Sub
Sub SendInfoEmail(emailInformation As Object)

Dim sBody As String
Dim sBodyStart As String
Dim sBodyInfo As String
Dim sBodyEnd As String
Dim emailAdress As Variant
Dim colLines As Collection
Dim line As Variant

    sBodyStart = "Hi, please find your account permissions below:" & vbCrLf


    For Each emailAdress In emailInformation
        Set colLines = emailInformation(emailAdress)
        sBodyInfo = ""
        For Each line In colLines
            sBodyInfo = sBodyInfo & _
                         "Application: " & line.app & vbTab & "Version:" & line.version & vbCrLf
        Next
        sBodyEnd = "Best Regards" & vbCrLf & _
                   "Team"

        sBody = sBodyStart & sBodyInfo & sBodyEnd
        SendEmail emailAdress, "Permissions", sBody
    Next


End Sub

Sub SendEmail(ByVal sTo As String _
              , ByVal sSubject As String _
                , ByVal sBody As String _
                  , Optional ByRef coll As Collection)


    #If Early Then
        Dim ol As Outlook.Application
        Dim outMail As Outlook.MailItem
        Set ol = New Outlook.Application
    #Else
        Dim ol As Object
        Dim outMail As Object
        Set ol = CreateObject("Outlook.Application")
    #End If

    Set outMail = ol.CreateItem(0)

    With outMail
        .To = sTo
        .Subject = sSubject
        .Body = sBody
        If Not (coll Is Nothing) Then
            Dim item As Variant
            For Each item In coll
                .Attachments.Add item
            Next
        End If

        .Display
        '.Send
    End With

    Set outMail = Nothing

End Sub