Normalizing Email Addresses/Email Headers

[tradeaccepted]

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.

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.

 

[tradeaccepted]

Cerfani,

This is what I got:

Sub EmailNormalization()

Dim theEmailTo As String
Dim r As Long, positionOfComma As Long, positionOfAt As Long

For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'Navigate to bottom of sheet, search up until it hits a non empty cell in column A, reference the row of that result.
    theEmailTo = Cells(r, 1) 'Search column A for the values
    positionOfComma = InStr(theEmailTo, ",") 'if no space found you will get 0
    positionOfAt = InStr(theEmailTo, "@") 'if no @ found you will get 0

	If positionOfComma > 0 And positionOfComma < positionOfAt Then

	    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
	End If
Next r

End Sub

I might have a better idea to get this completed. Could it be possible to edit the script to say "If the result is an empty string, do not change the value and leave as is?
This would help with the situation of "There is only an email address and no name, so the script deletes the email and leaves nothing".