Normalizing Email Addresses/Email Headers

tradeaccepted

New Member
Joined
Jun 11, 2013
Messages
33
I have a sheet that contains Email metadata. The data looks like this:

https://ethercalc.org/houk0a1zt3

The end goal is to take an email header that looks like: LASTNAME, FIRSTNAME[FIRST.LAST@example.com]
And convert it to only: LASTNAME, FIRSTNAME.
Problem is that there are many different formatting variations for email headers. You can view some of them in the EtherCalc link above.
The one thing that is absolute, is that each different recipient is separated by a semicolon.

I made a pretty simple Macro to complete this. After the below macro is run, you will see the results that are in Column B. This does handle most cases where I need to normalize an email address. I am running into a problem when there is no name for the email.

For example, if the address looked like this:[FIRST.LAST@example.com];[FIRST.LAST@example.com]
The VBA will return: ;

It will delete both email addresses, because that's exactly what the VBA tells it to do. If the email header looks like the above example, I would just want to return the actual email address without surrounding <>, () or [].


Has anyone come across this task or could think of a better way to complete this? Willing to abandon the entire VBA if someone thinks of a better way.


Code:
Sub normalize_emails_no_text_to_columns()
'
' normalize_emails_no_text_to_columns Macro
'
' This will remove all email addresses from column B that are surrounded by <>, () or [] from the sheet, leaving only names.
    Columns("B:B").Select
    Selection.Replace what:="<*>", replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Columns("B:B").Select
    Selection.Replace what:="(*)", replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Columns("B:B").Select
    Selection.Replace what:="
[*]", replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
' This will remove all of the (")s
    Columns("B:B").Select
    Selection.Replace what:="""", replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
' This will replace all ; ; with a single ;
    Columns("B:B").Select
    Selection.Replace what:="; ;", replacement:=";", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


' This will expand the columns to be readable
    Cells.Select
    Cells.EntireColumn.AutoFit
    

End Sub

As always, much appreciated for taking the time to read my request.
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

cerfani

Well-known Member
Joined
Dec 15, 2014
Messages
1,136
put the example emails here so we dont have to click links

not sure if this website has spoiler text but if it does and the list is long then use it
 
Last edited:

tradeaccepted

New Member
Joined
Jun 11, 2013
Messages
33
put the example emails here so we dont have to click links

not sure if this website has spoiler text but if it does and the list is long then use it

Pasting the email addresses into the below table, MrExcel is removing anything that in inside of a <>. Please use the link, there are no ads on the website.
If you do not want to click the link, here is a screenshot.



Here you go:
Code:
[TABLE="class: grid, width: 1002"]
<tbody>[TR]
[TD="align: center"][B]Email To
[/B][/TD]
[TD="align: center"][B]Email To[/B][/TD]
[/TR]
[TR]
[TD]LASTNAME, FIRSTNAME[FIRST.LAST@example.com][/TD]
[TD]LASTNAME, FIRSTNAME[/TD]
[/TR]
[TR]
[TD]LASTNAME, FIRSTNAME(FIRST.LAST@example.com)[/TD]
[TD]LASTNAME, FIRSTNAME[/TD]
[/TR]
[TR]
[TD]"Last, First" <first.last@example.com></first.last@example.com>[/TD]
[TD]Last, First[/TD]
[/TR]
[TR]
[TD]"Last, First" ; "Last, First"[/TD]
[TD]Last, First ; Last, First[/TD]
[/TR]
[TR]
[TD]"Last, First" ; "Last, First"[/TD]
[TD]Last, First ; Last, First[/TD]
[/TR]
[TR]
[TD]"Last, First" (First.Last@example.com)[/TD]
[TD]Last, First[/TD]
[/TR]
[TR]
[TD]"Last, First" ; Last, First (First.Last@example.com); ; "Last, First" [First.Last@example.com][/TD]
[TD]Last, First ; Last, First ; Last, First[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:

cerfani

Well-known Member
Joined
Dec 15, 2014
Messages
1,136
im not looking at your code so you can look at this example and maybe get an idea but you should just try to think of each situation and handle it separately... maybe some regex wizard can give you a single line of code but if you only have several different situations you can just test the condition and proceed accordingly...

Code:
If InStr(theEmailTo, "[") > 0 Then

ElseIf InStr(theEmailTo, "(") > 0 Then

ElseIf ...

End If

you just need to parse but think about several different situations, test the condition then parse it however
 
Last edited:

tradeaccepted

New Member
Joined
Jun 11, 2013
Messages
33

ADVERTISEMENT

im not looking at your code so you can look at this example and maybe get an idea but you should just try to think of each situation and handle it separately... maybe some regex wizard can give you a single line of code but if you only have several different situations you can just test the condition and proceed accordingly...

Code:
If InStr(theEmailTo, "[") > 0 Then

ElseIf InStr(theEmailTo, "(") > 0 Then

ElseIf ...

End If

you just need to parse but think about several different situations, test the condition then parse it however

I am not that good at VBA, I'm not sure how to loop through each cell individually. :(
I will do some more research and see what I find / report back. Thank you for taking time to read my question.
 
Last edited:

cerfani

Well-known Member
Joined
Dec 15, 2014
Messages
1,136
I am not that good at VBA, I'm not sure how to loop through each cell individually. :(
I will do some more research and see what I find / report back. Thank you for taking time to read my question.

using loops is not tough...

Code:
Dim r As Long
Dim theEmailTo As String

For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row [COLOR=#008000]'to get the last row, i go to the bottom of the sheet and search up until it hits a non empty cell in column A, then i reference the row of that result[/COLOR]
    theEmailTo = Cells(r, 1) [COLOR=#008000]'i am just making this up but i will say the email to addresses are in column A of active sheet

[/COLOR]    If InStr(theEmailTo, "[") > 0 Then
        ...
    ElseIf InStr(theEmailTo, "(") > 0 Then
        ...
    ElseIf ...
        ...
    End If
Next r

that code would do my example for every row starting at row 2 that has data in column A and it assumes column A is where my email addresses are... then you can perform an operation for each row and reference the data on each row for each operation
 
Last edited:

tradeaccepted

New Member
Joined
Jun 11, 2013
Messages
33

ADVERTISEMENT

using loops is not tough...

Code:
Dim r As Long
Dim theEmailTo As String

For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row [COLOR=#008000]'to get the last row, i go to the bottom of the sheet and search up until it hits a non empty cell in column A, then i reference the row of that result[/COLOR]
    theEmailTo = Cells(r, 1) [COLOR=#008000]'i am just making this up but i will say the email to addresses are in column A of active sheet

[/COLOR]    If InStr(theEmailTo, "[") > 0 Then
        ...
    ElseIf InStr(theEmailTo, "(") > 0 Then
        ...
    ElseIf ...
        ...
    End If
Next r

that code would do my example for every row starting at row 2 that has data in column A and it assumes column A is where my email addresses are... then you can perform an operation for each row and reference the data on each row for each operation



Thanks alot Cerfani, I will give this a go and let you know how it turns out!
 

tradeaccepted

New Member
Joined
Jun 11, 2013
Messages
33
Cerfani,

I was able to create the VBA with a loop, but still having trouble finding logic that will not remove the email address of a cell that doesnt have a name in front of it.
Here is my code:

Code:
Sub Macro42143123()
'
' Macro42143123 Macro
'
Dim r As Long
Dim theEmailTo As String

For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'to get the last row, i go to the bottom of the sheet and search up until it hits a non empty cell in column A, then i reference the row of that result
    theEmailTo = Cells(r, 1) 'i am just making this up but i will say the email to addresses are in column A of active sheet

    If InStr(theEmailTo, "[") > 0 Then
        Cells.Replace what:="
[*]", replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ElseIf InStr(theEmailTo, "(") > 0 Then
        Cells.Replace what:="(*)", replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ElseIf InStr(theEmailTo, "<") > 0 Then
        Cells.Replace what:="<*>", replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End If
Next r

End Sub

Do you have any ideas how I can accomplish that?
 

cerfani

Well-known Member
Joined
Dec 15, 2014
Messages
1,136
you would know if there was no name if you find a space (or maybe a comma) relative to the @ character...

Code:
Dim positionOfSpace As Long, positionOfAt As Long

positionOfSpace = InStr(theEmailTo, " ")[COLOR=#008000] 'if no space found you will get 0[/COLOR]
positionOfAt = InStr(theEmailTo, "@")

If positionOfSpace > 0 And positionOfSpace < positionOfAt Then [COLOR=#008000]'this tests if a space exists and if it precedes the @ symbol of an email address... email addresses wont have spaces so you know if a space exists before an email then it is probably the name[/COLOR]
    [COLOR=#008000]'looks like a name since there is a space before an @ character[/COLOR]
End If

actualy the if statement should read

Code:
If positionOfSpace = 0 Or positionOfSpace > positionOfAt Then [COLOR=#008000]' this might be better since it triggers true if it is the special case when there is no name and in this case you can just grab the email which you can detect by @ character[/COLOR]

unless you are a regex master or use parsing libraries, parsing text requires you to save positions of characters and then to perform operations that search for something starting at those positions... you can do anything but you need to identify patterns and program ways to get to the positions you want... you can parse anything though with string functions like Mid, InStr, etc... you dont need special libs or learn regex

the example is just an idea and may need some tuning to work with your code but you just need to find clues that suggest what format you are dealing with
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,109,250
Messages
5,527,633
Members
409,778
Latest member
MagalieD

This Week's Hot Topics

Top