Sub TidyEmailAddress() '(Ctrl+Shift+E)'Tidy's up email addresses
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'
Selection.ClearFormats
Selection.Hyperlinks.Delete
Selection.Replace What:="mailto:", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="] ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=">", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:=Chr(160), Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'remove email "name" from before email address
For Each c In Selection
c.Value = LCase(c)
start_pos = 0
On Error Resume Next
start_pos = Application.WorksheetFunction.Search("<", c)
If start_pos <> 0 Then
c.Value = Right(c, Len(c) - start_pos)
End If
Next c
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Cells.Find What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False
End Sub