VBA Select City from listbox the output email addresses in one cell

[LennyG2]

Hello everyone,

I'm trying to find VBA code where I can select multiple cities from a ListBox and output 5 email addresses associated with that city. The ListBox would only list the cities. The user would also be able to select more than one city. In my data, the city is in column "A" and the 5 email addresses are in columns B through F. The output would be on the same sheet in cell G1. So in the end, with 3 cities selected, the contents of G1 would have 15 email address (3 cities x 5 email addresses per city) separated by a semi colon so the user could just copy the results in G1 into the To field in an email. Anyone know where I can find this or offer some sample code? Thanks in advance.

 

[Puertorekinsam]

Okay I had to make some assumptions.
You didn't mention a form, so I guess the list box lives on the page, you also didn't say how the list box would be populated. So I made a button to do that (this code could be moved to the activate sheet code, or where you need.


On the sheet I added an activeX listbox and two buttons.

The first button named "LoadListBox has the following code

Private Sub LoadListBox_Click()
    Dim i As Integer
    i = 2
    
     Me.ListBox1.Clear
    Do Until Cells(i, 1) = ""
        Me.ListBox1.AddItem (Cells(i, 1))
        i = i + 1
    Loop

End Sub

This will put all the cities in your list box.

the listbox had the property changed to multiselect (I assume you know how to do that),but since you wanted to only select 3 cities I used this code

Private Sub ListBox1_Change()

Dim i As Integer
Dim selectedCities As Integer

selectedCities = 0

For i = 1 To ListBox1.ListCount
    If ListBox1.Selected(i - 1) = True Then selectedCities = selectedCities + 1
Next

If selectedCities >= 4 Then
    ListBox1.Selected(ListBox1.ListIndex) = False
    MsgBox "Limited to 3 Cities"
End If
End Sub

Finally there is the make the city email list button named "MakeList" and it has this code

Private Sub MakeList_Click()
Dim emailstring As String
    emailstring = ""
    
Dim i As Integer
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
            If Len(emailstring) > 0 Then emialstring = emailstring & ";"
            emailstring = emailstring & Cells(i + 1, 2) & ";" & Cells(i + 1, 3) & ";" & Cells(i + 1, 4) & ";" & Cells(i + 1, 5) & ";" & Cells(i + 1, 6) & ";"
            End If
            
        
        Next
    
    End With
    
    Cells(1, 7) = emailstring
    
End Sub

 

[Puertorekinsam]

small mistake, in the code for the second button ( I forgot to account for the header bar), the line should read:

emailstring = emailstring & Cells(i + 2, 2) & ";" & Cells(i + 2, 3) & ";" & Cells(i + 2, 4) & ";" & Cells(i + 2, 5) & ";" & Cells(i + 2, 6) & ";"

The Output will be the following