Parse email address from long strong

amwilber

Board Regular
Joined
May 15, 2008
Messages
162
Hello I have a long string of email addresses - in the hundreds that are all in one line. They are bracketed by <> and separated by ;.

How do I parse them into their own cell?


Example:

Fred Johnson<fred.johnshon@bla.com>;Jaime Post<jpost@yahoo.com>'.........


I want to turn into.

Fred.johnshon@bla.com
Jpost@yahoo.com
.
.
.
.


Thanks for the help!
 
Last edited by a moderator:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Your example doesn't show < or >, so what does the data really look like?
 
Upvote 0
@kweaver
The board converted the post to HTML because of the < & > tags. I have corrected the OP
 
Upvote 0
Here's one approach that seems to work with your long string in A1, the parse starts in A2.

Code:
Sub SplitEmail()
Dim strg As String, newstrg() As String, result As String, i As Integer, locb As Integer
strg = Range("A1")
newstrg = Split(strg, ";")
For i = 0 To UBound(newstrg())
result = newstrg(i)
locb = InStr(1, result, "<")
result = Right(result, Len(result) - locb)
locb = InStr(1, result, ">")
result = Left(result, locb - 1)
Cells(i + 2, 1) = result
Next i
End Sub
 
Upvote 0
A slightly different approach to kweaver's while using the same assumptions.
Code:
Sub LNG_String()


Dim My_String As String, Array_String_1() As String, X As Long

My_String = ActiveSheet.Range("A1").Value

Array_String_1 = Split(My_String, ">;")
For X = 0 To UBound(Array_String_1)
    Array_String_1(X) = Split(Array_String_1(X), "<")(1)
Next X
ActiveSheet.Range("A2").Resize(UBound(Array_String_1) + 1, 1).Value2 = WorksheetFunction.Transpose(Array_String_1)


End Sub
 
Last edited:
Upvote 0
Here is another approach you can consider (text assumed to be in cell A1, output starts at cell A2)...
Code:
Sub SplitEmails()
  Dim X As Long, Emails As Variant
  Emails = Split(Replace(Range("A1").Value, ">", "<"), "<")
  For X = 1 To UBound(Emails) Step 2
    Cells((X + 3) / 2, "A").Value = Emails(X)
  Next
End Sub
 
Upvote 0
Here is another approach you can consider (text assumed to be in cell A1, output starts at cell A2)...
Code:
Sub SplitEmails()
  Dim X As Long, Emails As Variant
  Emails = Split(Replace(Range("A1").Value, ">", "<"), "<")
  For X = 1 To UBound(Emails) Step 2
    Cells((X + 3) / 2, "A").Value = Emails(X)
  Next
End Sub
Actually, in thinking about it, the above macro can be done with just a single line of code...
Code:
Sub SplitEmails()
  [A2].Resize(UBound(Split([A1], "@"))) = Application.Transpose(Filter(Split(Replace([A1], ">", "<"), "<"), "@"))
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,103
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top