How to Insert another loop for inputting multiple receiver name in an Email based on criteria

AmirFirdaus9509

New Member
Joined
Feb 14, 2022
Messages
7
Office Version
  1. 2016
Platform
  1. Windows
Hi There ,
How to dynamically insert receiver name based on array that follow a criteria in the excel file.
For example , there are 3 different country US , JP and UK. The macro is able to create 3 different email draft and insert the table based on criteria of each country. It will create UK Email and only put table that have UK in Column A.
How to initiate another loop that insert receiver name only that is the same row as UK and will also loop for US and JP ?

1664341172867.png

Sample table containing data.

1664341307499.png


Here is the code that i working on with more country data in it

VBA Code:
Sub test()
     
    Dim my_array() As String
    Dim i As Integer
    Dim NumRows As Integer
    
    ReDim my_array(37)
    my_array(0) = "AU"
    my_array(1) = "BD"
    my_array(2) = "BN"
    my_array(3) = "CN"
    my_array(4) = "FJ"
    my_array(5) = "HK"
    my_array(6) = "ID"
    my_array(7) = "IN"
    my_array(8) = "JP"
    my_array(9) = "KH"
    my_array(10) = "KR"
    my_array(11) = "LA"
    my_array(12) = "LK"
    my_array(13) = "MM"
    my_array(14) = "MN"
    my_array(15) = "M0"
    my_array(16) = "MV"
    my_array(17) = "MY"
    my_array(18) = "NP"
    my_array(19) = "NZ"
    my_array(20) = "PH"
    my_array(21) = "PK"
    my_array(22) = "SG"
    my_array(23) = "TH"
    my_array(24) = "TW"
    my_array(25) = "VN"
    my_array(26) = "TO"
    my_array(27) = "CK"
    my_array(28) = "KI"
    my_array(29) = "NR"
    my_array(30) = "NC"
    my_array(31) = "NU"
    my_array(32) = "WS"
    my_array(33) = "SB"
    my_array(34) = "PF"
    my_array(35) = "TO"
    my_array(36) = "TV"
    my_array(37) = "VU"
    


    For i = LBound(my_array) To UBound(my_array)
        ActiveSheet.UsedRange.AutoFilter Field:=7, Criteria1:=my_array(i)
        
 
  Set URng = ActiveSheet.UsedRange
      NumRows = URng.Resize(, 1).SpecialCells(xlCellTypeVisible).Count
          
      If NumRows > 1 Then
    

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
   
    Set rng = Nothing
    On Error Resume Next
    
    Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
   
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

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

    On Error Resume Next
    With OutMail
    
        SName = " "
               
        .To = ""
        .CC = ""
        .BCC = ""
        .subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)
        '.Send
        .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing


 End If
     On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
        

    Next i
     
End Sub


Thanks for any assistance in advance
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Try this. I would put this just before
VBA Code:
Set OutApp = CreateObject("Outlook.Application")

VBA Code:
Dim j as Long
Dim recievers as String
With Sheets("Emails") 'change to whatever sheet you have the email addresses stored in.
   'find the last row in A with something in it
   lastrow = .Range("A" & Rows.Count).End(xlUp).Row
   'loop through the cells 
   For j = 2 To lastrow
        'if the country matches, add the email address to a string variable
        If .Cells(j, 1) = my_array(i) Then recievers = recievers & .Cells(j, 2) & ", "
   Next j
End With

and, in place of
VBA Code:
.To = ""
put
VBA Code:
.To = recievers
 
Upvote 0
Try this. I would put this just before
VBA Code:
Set OutApp = CreateObject("Outlook.Application")

VBA Code:
Dim j as Long
Dim recievers as String
With Sheets("Emails") 'change to whatever sheet you have the email addresses stored in.
   'find the last row in A with something in it
   lastrow = .Range("A" & Rows.Count).End(xlUp).Row
   'loop through the cells
   For j = 2 To lastrow
        'if the country matches, add the email address to a string variable
        If .Cells(j, 1) = my_array(i) Then recievers = recievers & .Cells(j, 2) & ", "
   Next j
End With

and, in place of
VBA Code:
.To = ""
put
VBA Code:
.To = recievers

Hi There ,
apologize for a late reply as i was not available to access internet for some time

Thanks for assisting me on this , I have encountered issue as the receipient name is duplicated from other countries into the email.
How to sort so it will only take under specific country for reciepient instead of all?
Thank you
 
Upvote 0
It should only give you the emails for the matching country. Can you post your code to see how you implemented what I had sent?
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,288
Members
448,563
Latest member
MushtaqAli

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top