Difficulty looping in VBA

I made a Code Visual Basics to identify the expiration of insurance policies and go up a pop-up and trigger an email alerting if it is near expiration.

The database contains the policy number, defined as valorApolice in Column and ;

The insured object group, defined as groupApolice in Column C ;

And the maturity date of the policy, defined as valorData in the column H .

I need this CoD to replicate for all rows filled in the base.

Follows cod I arrived: 

Sub Workbook_Open()



Worksheets("plan1").Select
Dim valorData As Date
Dim valorApolice As String
Dim groupApolice As String

valorData = Range("H11").Value
valorApolice = Range("e11").Value
groupApolice = Range("c11").Value


If DateDiff("d", Now(), valorData) < 0 Then
    msgbox "Atenção: A apólice de seguro " & valorApolice & " de " & groupApolice & ", está vencida!", vbInformation + vbOKOnly

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)

        Application.DisplayAlerts = False
     With OutMail
    .To = "[email protected]"
    .CC = ""
    .BCC = ""
    .Subject = "TESTE: Vencimento de Apólice de Seguro"
    .HTMLBody = "TESTE: Atenção: A apólice de seguro " & valorApolice & " de " & groupApolice & ", está vencida! Entrar em contato com Corretora de Seguros urgente."
    .Send 'Ou .Display para mostrar o email
        End With
         Application.DisplayAlerts = True
         Set OutMail = Nothing
         Set OutApp = Nothing

ElseIf DateDiff("d", Now(), valorData) < 30 Then
    msgbox "Atenção: a apólice de seguro " & valorApolice & " de " & groupApolice & ", tem vencimento dentro do mês!", vbInformation + vbOKOnly


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)

        Application.DisplayAlerts = False
     With OutMail
    .To = "[email protected]"
    .CC = ""
    .BCC = ""
    .Subject = "Vencimento de Apólice de Seguro"
    .HTMLBody = "Atenção: A apólice de seguro " & valorApolice & " de " & groupApolice & ", está vencendo! Entrar em contato com Corretora de Seguros."
    .Send 'Ou .Display para mostrar o email
        End With
         Application.DisplayAlerts = True
         Set OutMail = Nothing
         Set OutApp = Nothing
End If




msgbox "Não há mais outros vencimentos de seguros dentro de um mês.", vbInformation + vbOKOnly
Worksheets("MENU").Select
End Sub


msgbox "Não há mais outros vencimentos de seguros dentro de um mês.", vbInformation + vbOKOnly
Worksheets("MENU").Select
End Sub
Author: Amadeu, 2019-10-09
Source

2 answers

Consider using the while structure.

The structure will look something like this: 

Sub enviar_email()

lin = 1
col = 8 'Coluna H


Do While Sheet1.Cells(lin, col).Value <> ""
    Sheet1.Cells(lin, col).Select
        'Aqui vem o seu código com as regras de negócio
    lin = lin + 1
Loop

End Sub
 0
Author: LePy, 2019-10-09 19:25:15

If the code is working for an individual execution, all you have to do is run it indefinitely as long as some condition is true. For example, as long as column Base has records, it runs for that row. When he gets on a line where he has no more data he stops.

So just encapsulate your code with: 

Dim x As Integer

Range("E11").Select
NumRows = Range("E11", Range("E11").End(xlDown)).Rows.Count

For x = 1 To NumRows
    valorApolice = ActiveCell.Value
    valorData = ActiveCell.Offset(0, 3)
    groupApolice = ActiveCell.Offset(0, -2)

    ...
    Seu código
    ...

    ActiveCell.Offset(1, 0).Select

    Next x

Note that I have made your references dynamic now. In the end, your code should be: 

Sub Workbook_Open()

Dim valorData As Date
Dim valorApolice As String
Dim groupApolice As String
Dim x As Integer


Range("E11").Select
NumRows = Range("E11", Range("E11").End(xlDown)).Rows.Count

For x = 1 To NumRows
    valorApolice = ActiveCell.Value
    valorData = ActiveCell.Offset(0, 3)
    groupApolice = ActiveCell.Offset(0, -2)

    If DateDiff("d", Now(), valorData) < 0 Then
        MsgBox "Atenção: A apólice de seguro " & valorApolice & " de " & groupApolice & ", está vencida!", vbInformation + vbOKOnly

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)

        Application.DisplayAlerts = False
        With OutMail
            .To = "[email protected]"
            .CC = ""
            .BCC = ""
            .Subject = "TESTE: Vencimento de Apólice de Seguro"
            .HTMLBody = "TESTE: Atenção: A apólice de seguro " & valorApolice & " de " & groupApolice & ", está vencida! Entrar em contato com Corretora de Seguros urgente."
            .Send 'Ou .Display para mostrar o email
        End With
        Application.DisplayAlerts = True
        Set OutMail = Nothing
        Set OutApp = Nothing

    ElseIf DateDiff("d", Now(), valorData) < 30 Then
        MsgBox "Atenção: a apólice de seguro " & valorApolice & " de " & groupApolice & ", tem vencimento dentro do mês!", vbInformation + vbOKOnly


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)

        Application.DisplayAlerts = False
        With OutMail
            .To = "[email protected]"
            .CC = ""
            .BCC = ""
            .Subject = "Vencimento de Apólice de Seguro"
            .HTMLBody = "Atenção: A apólice de seguro " & valorApolice & " de " & groupApolice & ", está vencendo! Entrar em contato com Corretora de Seguros."
            .Send 'Ou .Display para mostrar o email
        End With
        Application.DisplayAlerts = True
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If

    ActiveCell.Offset(1, 0).Select


    Next x

End Sub

P.S. Your code was with the duplicate ending, but I think you must have been wrong when copying and pasting. I've edited your question.

 1
Author: Evilmaax, 2019-10-09 19:36:27