Excel VBA - How do I populate an array-CodePudding

Below is the full code that I wish to implement.

The main objective is to send an email with the values the code returns as a single email.

The output of this code is the last value instead of all the values in the email.

`Sub Email()

Dim Outlook, OutApp, OutMail As Object
Dim EmailSubject As String, EmailSendTo As String, MailBody As String
Dim SigString As String, Signature As String, fpath As String
Dim Quarter As String, client() As Variant
Dim Alert As Date, Today As Date, Days As Integer, Due As Integer

Set Outlook = OpenOutlook

Quarter = Range("G4").Value
Set rng = Range(Range("G5"), Range("G" & Rows.Count).End(xlUp))

'Resize Array prior to loading data
ReDim client(rng.Rows.Count)

'Check column G for blank cells and return F cells
For Each Cell In rng
If Cell.Offset(0, 1).Value = "" Then
    ReDim client(x)
    Alert = Cell.Offset(0, 0).Value
    Today = Format(Now(), "dd-mmm-yy")
    Days = Alert - Today
    Due = Days * -1
    client(x) = Cell.Offset(0, -3).Value & " " & Cell.Offset(0, -1).Value
End If
Next
    For x = LBound(client) To UBound(client)
        List = client(x) & vbNewLine
        List = List   List
    Next x
        
'Check dates to send subject line'
    If Days < 0 Then
    mail = True
    EmailSubject = Quarter & " Vat Returns are Overdue"
    MailBody = "<p>The Vat Returns are overdue by " & Due & " Days. See the clients below: </p>" & List
    ElseIf Days <= 14 Then
    mail = True
    EmailSubject = "Vat Returns are due within Two weeks"
    MailBody = "<p>The Vat Returns are due in " & Days & " Days. See the clients below: </p>" & List
    End If
  
'Fetch signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\.htm"
    Signature = GetBoiler(SigString)
    
'Fetch link for file location
    fpath = "K:
    
'Skip if mail=false
    If mail = True Then
    
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = EmailSubject
            .To = ""
            '.bcc
            sHTML = "<HTML><BODY>"
            sHTML = sHTML & "<p>Hi, </p>"
            sHTML = sHTML & MailBody
            sHTML = sHTML & "<p>If the Vat Return have been filed, please update the database using the link below.</p>"
            sHTML = sHTML & "<A href='" & fpath & "'></A>"
            sHTML = sHTML & "<p>Regards,</p>"
            .HTMLBody = sHTML & Signature
            .HTMLBody = .HTMLBody & "</BODY></HTML>"
            .Display
        End With
        
        Set Outlook = Nothing
        Set OutMail = Nothing
        Set OutApp = Nothing
        
        mail = False
        EmailSendTo = ""
        
    End If

End Sub`

All the code does is return the last value in the if statement and place it in an email.

What I want to achieve is that the code will run though the range of data. If the cell in column G:G is blank then return the cell value in column F:F.

I want the code to store these values to then send an email to an email address. I can code it to send multiple emails to one email address with one cell value in each email. I want it to send one single email to the email address with all (multiple) cell values that is returned.

I have taken out all the personal details in the code but this will not affect the running of the code.

CodePudding user response：

No need for the client() array if you build the List directly.

Today = Format(Now(), "dd-mmm-yy")
For Each cell In Rng
    If cell.Offset(0, 1).Value = "" Then
        Alert = cell.Offset(0, 0).Value
        Days = Alert - Today
        Due = Days * -1
        If Len(List) > 0 Then List = List & vbNewLine
        List = List & cell.Offset(0, -3).Value & " " & cell.Offset(0, -1).Value
    End If
Next

Note OutApp.CreateItem(o) should be OutApp.CreateItem(0)