Send one email with all the topics pending for the person

Question

I am trying to create a macro where the all pending tasks for one person, one e-mail, will be included in one Outlook e-mail. Basically the program will search for the pending tasks, group them all and send it to the e-mail address of the person it is assigned to.

I was able to modify/create a code where the pending task reminders are sent automatically, but it is sending one task per e-mail. This floods the person with multiple reminders.

Is it possible to have one e-mail reminder that includes all the pending tasks for that person?

Sub Reminder()
    Dim wStat As Range, i As Long
    Dim dam As Object
    
    For Each wStat In Range("D6", Range("D" & Rows.Count).End(xlUp))
        If wStat.Value = "Pending" Then
            i = wStat.Row
            If Cells(i, "I").Value <= Range("I3").Value Then
                Set dam = CreateObject("Outlook.Application").CreateItem(0)
                dam.To = Range("L" & i).Value
                dam.CC = Range("L" & i).Value
                dam.Subject = Range("B" & i).Value
                dam.Body = "Dear " & Range("E" & i).Value & "," & vbCr & vbCr & _
                    "This is to remind you that the task: " & Range("B" & wStat.Row).Value & " - " & " " & _
                    "is still pending." & vbCr & vbCr & _
                    "Thank you!"
                '
                dam.Send 'change send to display if you want to check
                wStat.Value = "Pending"
           End If
        End If
    Next

    MsgBox "Reminders Sent!"
End Sub

This is the sample Excel file

This is what it looks like now

This is what I want it to look like

Answer 1

Based on the image of the file, to create only one email

Option Explicit

Sub Reminder()

    Dim wks As Worksheet
    Set wks = ActiveSheet
    
    Dim LastRow As Long
    Dim taskStr As String
    
    Dim olApp As Object
    Dim dam As Object
    
    Set olApp = CreateObject("Outlook.Application")
    Set dam = olApp.CreateItem(0)
    
    dam.To = wks.Range("B2").Value
    dam.Subject = "Pending Tasks"
    
    LastRow = wks.Cells(wks.Rows.count, "A").End(xlUp).Row
    Debug.Print "LastRow: " & LastRow
    
    For i = 2 To LastRow
        taskStr = taskStr & wks.Range("A" & i).Value & vbCr
        Debug.Print taskStr
    Next
    
    dam.body = "Dear " & wks.Range("C2").Value & "," & vbCr & vbCr & _
                "The tasks below are still pending: " & vbCr & vbCr & taskStr
                
    dam.Display
    
End Sub