How to create email addresses (fn.ln@company.com) using VBA

[Peepah]

Hi guys,

I have figured out how to create firstname.lastname@company.com from a list of names like Mike Jones using Excel functions.

I would like to do the same using VBA
So that my boss would have a column to list the attendees of a training course and an empty column on the right which will automatically display the email address. All the email addresses are in our company, so all they all end in @company.com:

A B
Mike Jones mike.jones@company.com
Paula Forester paula.forrester@company.com
Paul van der Merwe paul.vandermerwe@company.com

OR if you could create this whole process into a single formula (rather than VBA) that would work too. At the moment I extract the first name with

=FIND(" ",'Delegate lists'!K9) - to find the space between the first name and last name

=LEFT('Delegate lists'!K9,B2-1) to extract everything to the left of the " "
=LEN('Delegate lists'!K9) to find the length of the total name
=MID('Delegate lists'!K9,B2+1,D2-B2) to extract the last name
=SUBSTITUTE(E2, " ", "") to take out any spaces in the last name like in the case of Paul van der Merwe

=C2&"."&F2&"@company.com" to create the basic email address
=LOWER(Sheet1!G2) to create the email address in lower case

Any ideas?? Thanks 1,000,000

 

[Andrew Poulsom]

Why do you need VBA if you have figured out how to create the EMail address using Excel functions? What functions did you use?

 

[Peepah]

Because at the moment all the formulas (as listed) are each kept in a seperate cell which makes the file huge and is cumbersome. i would like to be able to write the same information in a single formula if possible or use VBA

I found: where the name -like John Jones- is in cell A10

=SUBSTITUTE(LEFT(A10,FIND(" ",A10)-1)&"."&RIGHT(A10,LEN(A10)-FIND(" ",A10))&"@company.com"," ","")

which is great but doesn't put the results in lower case. can I add =lower in some way? That would solve my problem.

thanks!

 

[Andrew Poulsom]

Try this in one cell:

=LOWER(SUBSTITUTE(SUBSTITUTE('Delegate lists'!K9," ",".",1)," ","")&"@company.com")

 

[jindon]

Hi
vba

Sub test()
Dim r As Range, x, i As Integer
For Each r In Range("a1", Range("a65536").End(xlUp))
    If Not IsEmpty(r) Then
        x = Split(r)
        If UBound(x) > 0 Then
            For i = 1 To UBound(x)
                txt = txt & x(i)
            Next
            txt = x(0) & "." & txt & "@company.com"
        Else
            txt = x(0) & "@company.com"
        End If
        r = LCase(txt)
        txt = Empty
    End If
Next
End Sub

 

[Peepah]

Thank you thank you thank you thank you (Andrew)

That works like a dream

May try the other solution just for the hell of it

 

[Peepah]

just one more thing...

Can you add a condition to that formula so that if the cell it refers to is empty the cell the result appears in will be empty rather than showing

@company.com

?

thanks 1,000,000,000

 

[Andrew Poulsom]

Try:

=IF(LEN('Delegate lists'!K9),LOWER(SUBSTITUTE(SUBSTITUTE('Delegate lists'!K9," ",".",1)," ","")&"@company.com"),"")

 

[Peepah]

You are a genius!