Combobox - named ranges and criteria - VBA

[Retroshift]

Hi, I have a macro button to open a userform mailing list (see image) which includes a combobox and listboxes. I had written code which got enhanced by member 'beyond Excel' below. Credits to him/her. The goal is to save the Sender, CC and Recipient addresses in named ranges on the data sheet (which already contains the "Tabla1" general address list), so I can use them for e-mail drafting later on.

How do I get these different Sender, CC and Recipient addresses in named ranges?

And which code should be included in order to have the following mandatory criteria when the user wants to add a new address entry in the combobox (without limiting the search option of the combobox):
- no spaces (in the beginning, middle, end of entry)
- all lowercase characters
- the new entry should end on "@x.y.z" with msgbox warning if criterium is not met
- msgbox warning if less than one mail address in sender listbox1
- msgbox warning if less than one mail address in recipient listbox3

My coding knowledge is very limited so any help would be greatly appreciated. Thanks

Option Explicit
Dim LObj As ListObject, inProcess As Boolean

Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 44 Then KeyAscii = 46 'change commas in entry to dots (= criterium)
End Sub

Private Sub ComboBox1_Change()
Dim a, b
If inProcess Then Exit Sub
If ComboBox1.ListIndex > -1 Then Exit Sub

a = Application.Transpose(LObj.DataBodyRange.Value)
b = Filter(a, ComboBox1, True, vbTextCompare)
ComboBox1.Clear: CBExit.SetFocus: ComboBox1.SetFocus
If UBound(b) > -1 Then
  ComboBox1.List = b
  ComboBox1.DropDown
End If
End Sub

Private Sub Add(lb As MSForms.ListBox)
If ComboBox1 = "" Then Exit Sub
On Error Resume Next
  lb = ComboBox1: If lb.ListIndex = -1 Then lb.AddItem ComboBox1
On Error GoTo 0
lb.ListIndex = -1

If ComboBox1.ListIndex = -1 Then
  LObj.ListRows.Add.Range = ComboBox1
  LObj.Range.Sort LObj.Range(1), xlAscending, Header:=xlYes
  ComboBox1.AddItem ComboBox1
End If
End Sub

Private Sub Remove(lb)
Dim i&
i = lb.ListIndex
If i = -1 Then
MsgBox "Please select the e-mail address you would like to remove from the list.", vbInformation, "FIRST SELECT OR ADD ENTRY TO REMOVE" 'If nothing selected
Exit Sub
End If
If i > -1 Then
  lb.ListIndex = -1
      If MsgBox("This will remove the e-mail address """ & lb.List(i) & """ from the list. Are you sure?", vbYesNo, "REMOVE ADDRESS") = vbNo Then Exit Sub  'Warning message
  lb.RemoveItem i
End If
End Sub

Private Sub CBAddSender_Click(): Add ListBox1: End Sub
Private Sub CBAddCC_Click(): Add ListBox2: End Sub
Private Sub CBAddRecipient_Click(): Add ListBox3: End Sub

Private Sub CBRemoveSender_Click(): Remove ListBox1: End Sub
Private Sub CBRemoveCC_Click(): Remove ListBox2: End Sub
Private Sub CBRemoveRecipient_Click(): Remove ListBox3: End Sub

Private Sub CommandButton1_Click()
Dim i&, sTxt$
i = ComboBox1.ListIndex: If i = -1 Then Exit Sub
inProcess = True
  If MsgBox("This will remove the e-mail address """ & ComboBox1.List(i) & """ from the general address list. Are you sure?", vbYesNo, "REMOVE ENTRY") = vbNo Then Exit Sub 'Warning message
  sTxt = ComboBox1: ComboBox1.ListIndex = -1: ComboBox1.RemoveItem i
inProcess = False
i = Application.Match(sTxt, LObj.DataBodyRange, 0)
LObj.ListRows(i).Delete
End Sub

Private Sub UserForm_Initialize()
Set LObj = Range("Tabla1").ListObject
ComboBox1.List = LObj.DataBodyRange.Value
End Sub

Private Sub CBExit_Click()
Me.Hide
End Sub

 

[Retroshift]

Anyone? I add the link to the workbook.

 

[dmt32]

Hi,
link to your file not too helpful as need to be a registered member on that forum.
Better to place on a file sharing site like dropbox.

Dave

 

[Retroshift]

Hi Dave,
I uploaded the file to dropbox.