Yes Bob, my apology.. You are Right -- I am not Snowfire as you assumed - I
just try to learn by looking over the shoulder of others that do not know...
Actually, My first "impression" was to put the one-linner inside of the On
Focus event, then second inside the Worksheet_Activate Code.. But both
without success.. Therein the Q...
Can you OPEN MY EYES?
Jim
- Show quoted text -
I need to store two parts of an Email address so the user can select
from drop-down combo's
in a way that they can build/select/edit and remove from a userforms
combo's interface.
I didn't want to store a list of E. address on a spreadsheet but semi
hide them away.
The following code will no dought be torn apart by the experts but
since Jim has shown an interest
this is what I have so far.....
I have two public variables declared in the module that holds the Emai
sendin code....
before you ask I am forced to use Lotus Notes !!
I remove unwanted entries with a Double-Click on each combo
Option Explicit
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim msg As Variant, Title As Variant, Response As Variant, Style As
Variant
Dim RemovEntry As Variant, LinesLeft As Integer
If Me.ComboBox1.Value = "" Then Exit Sub
msg = "Do you Want D E L E T E " & Me.ComboBox1.Value & " Entry...?"
& Chr(10) & _
Chr(10) & Chr(10) & Chr(10) & "Please choose [ Yes ] or [ No ]
Below" & Chr(10)
Title = "Remove Drop-Down Selection? "
Style = vbYesNo + vbQuestion + vbDefaultButton2
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
With Me.ComboBox1
RemovEntry = .Value
LinesLeft = .ListCount
.RemoveItem .ListIndex
End With
Me.ComboBox1.Value = ""
If LinesLeft > 1 Then
ThisWorkbook.Names.Add Name:="EmailName",
RefersTo:=Me.ComboBox1.List, Visible:=False
If Len(RemovEntry) > 0 Then MsgBox RemovEntry & " has been
removed from List", vbInformation, "Remove Email Name Prefix"
EmailName = ""
Else
ThisWorkbook.Names("EmailName").Delete
EmailName = ""
End If
End If
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim msg As Variant, Title As Variant, Response As Variant, Style As
Variant
Dim RemovEntry As Variant, LinesLeft As Integer
If Me.ComboBox2.Value = "" Then Exit Sub
msg = "Do you Want D E L E T E " & Me.ComboBox2.Value & " Entry...?"
& Chr(10) & _
Chr(10) & Chr(10) & Chr(10) & "Please choose [ Yes ] or [ No ]
Below" & Chr(10)
Title = "Remove Drop-Down Selection? "
Style = vbYesNo + vbQuestion + vbDefaultButton2
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
With Me.ComboBox2
RemovEntry = .Value
LinesLeft = .ListCount
.RemoveItem .ListIndex
End With
Me.ComboBox2.Value = ""
If LinesLeft > 1 Then
ThisWorkbook.Names.Add Name:="EmailDomain",
RefersTo:=Me.ComboBox2.List, Visible:=False
If Len(RemovEntry) > 0 Then MsgBox RemovEntry & " has been
removed from List", vbInformation, "Remove Email Domain Suffix"
EmailName = ""
Else
ThisWorkbook.Names("EmailDomain").Delete
EmailName = ""
End If
End If
End Sub
Private Sub CommandButton1_Click()
If EmailName = "" Then
MsgBox "Select from dropdown...." & Chr(10) & _
"or Enter NEW Email Prefix", vbCritical, "Enter first part of
Address !!!"
Exit Sub
End If
If EmailDomain = "" Then
MsgBox "Select from dropdown...." & Chr(10) & _
"or Enter NEW Email Suffix", vbCritical, "Enter Domain part of
Address !!!"
Exit Sub
End If
Unload Me
End Sub
Private Sub CommandButton3_Click()
Unload Me
EmailName = ""
EmailDomain = ""
End Sub
Private Sub UserForm_Activate()
Dim nm As Name
Dim EmailNameList As Boolean, EmailDomainList As Boolean
For Each nm In ThisWorkbook.Names
If nm.Name = "EmailName" Then
EmailNameList = True
Exit For
Else
EmailNameList = False
End If
Next
For Each nm In ThisWorkbook.Names
If nm.Name = "EmailDomain" Then
EmailDomainList = True
Exit For
Else
EmailDomainList = False
End If
Next
If EmailNameList = False Then
EmailName = Array("Enter Name here")
ThisWorkbook.Names.Add Name:="EmailName", RefersTo:=EmailName,
Visible:=False
Me.ComboBox1.List =
Application.Evaluate(Names("EmailName").RefersTo)
Else
Me.ComboBox1.List =
Application.Evaluate(Names("EmailName").RefersTo)
End If
If EmailDomainList = False Then
EmailDomain = Array("Enter Domain here")
ThisWorkbook.Names.Add Name:="EmailDomain", RefersTo:=EmailDomain,
Visible:=False
Me.ComboBox2.List =
Application.Evaluate(Names("EmailDomain").RefersTo)
Else
Me.ComboBox2.List =
Application.Evaluate(Names("EmailDomain").RefersTo)
End If
End Sub
Private Sub ComboBox1_AfterUpdate()
Dim I As Integer
With Me.ComboBox1
If .ListIndex = -1 And .Text <> "" Then
' add to list but keep it in alphabetical order
For I = 0 To .ListCount - 1
If UCase(.List(I)) > UCase(.Text) Then
Exit For
End If
Next
.AddItem .Text, I
End If
End With
EmailName = Me.ComboBox1.Value
If Len(EmailName) > 1 Then ThisWorkbook.Names.Add Name:="EmailName",
RefersTo:=Me.ComboBox1.List, Visible:=False
End Sub
Private Sub ComboBox2_AfterUpdate()
Dim I As Integer
With Me.ComboBox2
If .ListIndex = -1 And .Text <> "" Then
' add to list but keep it in alphabetical order
For I = 0 To .ListCount - 1
If UCase(.List(I)) > UCase(.Text) Then
Exit For
End If
Next
.AddItem .Text, I
End If
End With
EmailDomain = Me.ComboBox2.Value
If Len(EmailDomain) > 1 Then ThisWorkbook.Names.Add
Name:="EmailDomain", RefersTo:=Me.ComboBox2.List, Visible:=False
End Sub
If any one can suggest improvements (and there must be many!!! )
then.....more the merrier
Kind regards Mike
