Difficulty to loop in VBA

Question

I made a code Visual Basics to identify the maturity of insurance policies and raise a pop-up and fire an email alerting you if you are close to maturity.

The database is displaying the Policy Number, defined as valorApolice in the column And;

the Object Group insured, defined as groupApolice in the column C ;

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

I need that Cód to replicate for all rows filled in at the base.

It follows Cód that 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

Answer 1

If the code is working for an individual run, all you have to do is run it indefinitely while some condition is true. For example, while the column Base has records, it runs to that line. When it arrives on a line where there is no more data it to.

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 mistaken when copying and pasting. I’ve already edited your question.

Answer 2

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