How can I create a replay loop from different cells?

I am developing an expiration control that should send notices to people that the documents are close to expiration, there are documents that should be charged 180 days before the expiration date and others with only 30 days, the idea is that this VBA instead of sending 1200 documents in several emails, send a list of expired documents to people, for example: to analyst Valeria we must send the collection of more than 100 documents that are expired, but instead of sending 100 emails, create a list and send it in a single email leaving its management in copy. Below is the code and photo of the spreadsheet:

I made this code, but it is not meeting my real need:

    Sub alerta_email()

Dim MeuOutlook As Outlook.Application
Dim CriarEmail As Outlook.MailItem

Range("E14").Activate

Do Until ActiveCell.Value = ""

If ActiveCell.Offset(0, 1).Value < Range ("F14").Value or ActiveCell.Offset(0, 1).Value < Range ("F15").Value Then

Set MeuOutlook = New Outlook.Application
Set CriarEmail = MeuOutlook.CreateItem(olMailItem)

With CriarEmail
     .BodyFormat = olFormatHTML
     .Display
     .HTMLBody = "Automatic alert" & "<br>" & "The document: " _
     & ActiveCell.Offset(0,2).Value & " Belonging to the group " _
     & ActiveCell.Offset(0, -3).Value & " It will expire in " _
     & ActiveCell.Offset(0, 1).Value & " days."
     .To = Range("N14").Value
     .CC = Range ("O14").Value
     .Subject = "Contract expiration alert: " & 
      ActiveCell.Offset(0, -2).Value
     .Send
End With

End If

ActiveCell.Offset(1, 0).Select

Loop

MsgBox ("Alert sent successfully")

End Sub

When I run the macro it is also considering the documents that are not expired. And the entire list she is considering sending only to Ana and her manager, instead of considering another analyst and another manager of this analyst.

Workbook]1 Workbook 2]2

Assuming your analista column is properly sort and that column P is avaiable, try this:

Option Explicit

Sub alerta_email()
    
    Dim MeuOutlook As Outlook.Application
    Dim CriarEmail As Outlook.MailItem
    Dim RngDataVencimento As Range
    Dim RngDiaMargem As Range
    Dim RngMailAnalista As Range
    Dim RngMailSupervisor As Range
    Dim RngGarantia As Range
    Dim RngNome As Range
    Dim RngRelatorio As Range
    Dim DblIndice As Double
    Dim StrListaExpiracao As String
    Dim StrListaSupervisor As String
    
    
    Set RngDataVencimento = Range("E13")
    Set RngDiaMargem = Range("F13")
    Set RngMailAnalista = Range("N13")
    Set RngMailSupervisor = Range("O13")
    Set RngGarantia = Range("G13")
    Set RngNome = Range("B13")
    Set RngRelatorio = Range("P13") '<If column P is already taken, pick another one
    
    
    DblIndice = 0
    
    Do
        
        DblIndice = DblIndice + 1
        
        Set MeuOutlook = New Outlook.Application
        Set CriarEmail = MeuOutlook.CreateItem(olMailItem)
        
        If RngDataVencimento.Offset(DblIndice, 0).Value2 - RngDiaMargem.Offset(DblIndice, 0).Value2 <= Date Then
            
            If RngRelatorio.Offset(DblIndice, 0).Value2 = "" Then
                
                If RngMailAnalista.Offset(DblIndice, 0).Value2 <> RngMailAnalista.Offset(DblIndice - 1, 0).Value2 Then
                    
                    StrListaExpiracao = "Automatic alert" & "<br>" & "<br>" & _
                                        "The document: " & RngGarantia.Offset(DblIndice, 0).Value2 & _
                                        " Belonging to the group " & RngNome.Offset(DblIndice, 0).Value2 & _
                                        " It will expire in " & CDbl(RngDataVencimento.Offset(DblIndice, 0).Value2 - Date) & _
                                        " days." & "<br>"
                    StrListaSupervisor = RngMailSupervisor.Offset(DblIndice, 0) & ";"
                    
                Else
                    
                    StrListaExpiracao = StrListaExpiracao & _
                                        "The document: " & RngGarantia.Offset(DblIndice, 0).Value2 & _
                                        " Belonging to the group " & RngNome.Offset(DblIndice, 0).Value2 & _
                                        " It will expire in " & CDbl(RngDataVencimento.Offset(DblIndice, 0).Value2 - Date) & _
                                        " days." & "<br>"
                    
                    Select Case Len(StrListaSupervisor)
                        Case Is = 0
                            
                            StrListaSupervisor = RngMailSupervisor.Offset(DblIndice, 0) & ";"
                            
                        Case Is = Len(Replace(StrListaSupervisor, RngMailSupervisor.Offset(DblIndice, 0), ""))
                            
                            StrListaSupervisor = StrListaSupervisor & RngMailSupervisor.Offset(DblIndice, 0) & ";"
                            
                    End Select
                    
                End If
                
                RngRelatorio.Offset(DblIndice, 0).Value2 = Date
                
            End If
            
        End If
        
        If RngMailAnalista.Offset(DblIndice, 0).Value2 <> RngMailAnalista.Offset(DblIndice + 1, 0).Value2 Then
            
            If StrListaExpiracao <> "" Then
                
                With CriarEmail
                     .BodyFormat = olFormatHTML
                     .Display
                     .HTMLBody = StrListaExpiracao
                     .To = RngMailAnalista.Offset(DblIndice, 0).Value2
                     .CC = StrListaSupervisor
                     .Subject = "Contract expiration alert"
                     .Send
                End With
                
            End If
            
            StrListaSupervisor = ""
            StrListaExpiracao = ""
            
        End If
        
    Loop Until RngDataVencimento.Offset(DblIndice + 1).Value2 = ""
    
    MsgBox ("Alert sent successfully")
    
End Sub