Multiselections in ComboBox

[tigerdel]

Hi All

I am creating an email useform wherethe user may need to select more than one email address to send to

I have the code below which works perfectly well in a worksheet list but doen't work in a userform.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
pplication.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = cmbemail Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
 Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Does any one know how I can get a Userform Combobox or Listbox to allow the selction of multiiple entries?


Many thanks

Derek

 

[Norie]

Derek

Is it a combobox or a listbox?

If it's the latter then it's straightforward to allow multiple selections, all you need to do is set the MultiSelect property appropriately.

 

[tigerdel]

Hi

Thanks for the quick response

I would prefer it to be a combobox but would be open to using a ListBox if it is easier to do

How would I code either?

Thanks

Derek

 

[Norie]

Derek

You can't make multiple selections in a combobox so you would need similar code to that you posted that takes the value the user has selected and adds it to a list of previously selected values, and that list would need to be displayed/stored somewhere.

With a listbox set to allow mutiple selections all the user would need to do would be select (or deselect) the values the want from the list.

 

[tigerdel]

Thanks again

I have the following code to send the email which fails at sendto = UserForm1.ListBox1.List

Anyhelp gratefully received

Public Function SendEmail()
Dim esubject As String
Dim sendto As String
Dim ebody As String
Dim App As Outlook.Application
Dim itm As Outlook.MailItem
On Error GoTo Ende
esubject = UserForm1.lblFileName.Caption & "-Review by " & UserForm1.cmbReviewer.Value
sendto = UserForm1.ListBox1.List
ebody = UserForm1.TextBox1.Value
Set App = CreateObject("Outlook.Application")
Set itm = App.createitem(0)
With itm
.to = sendto
.Subject = esubject
.body = ebody
.Display
End With
Set App = Nothing
Set itm = Nothing
Ende:

End Function

 

[Norie]

Unfortunately it's not that simple.

You need to loop through the items in the listbox, see which ones have been selected and construct a suitable recipient list.

Something like this perhaps.

Dim arrEmails()
Dim cnt As Long

    With ListBox1

        ReDim arrEmails(1 To .ListCount)

        For I = 0 To .ListCount-1
            If .Selected(I) Then
                cnt = cnt + 1
                arrEmails(cnt) = .List(I)
            End If
        Next I

    End With

    If cnt>0 Then
        ReDim Preserve arrEmails(1 To cnt)
        sendto = Join(arrEmails, ";")
    Else
        MsgBox "No emails selected!"
        Exit Sub
    End If