Parse email address from long strong

[amwilber]

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!

 

[kweaver]

Your example doesn't show < or >, so what does the data really look like?

 

[Fluff]

@kweaver
The board converted the post to HTML because of the < & > tags. I have corrected the OP

 

[kweaver]

Here's one approach that seems to work with your long string in A1, the parse starts in A2.

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

 

[MoshiM]

A slightly different approach to kweaver's while using the same assumptions.

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

 

[Rick Rothstein]

Here is another approach you can consider (text assumed to be in cell A1, output starts at cell A2)...

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

 

[Rick Rothstein]

Here is another approach you can consider (text assumed to be in cell A1, output starts at cell A2)...

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...

Sub SplitEmails()
  [A2].Resize(UBound(Split([A1], "@"))) = Application.Transpose(Filter(Split(Replace([A1], ">", "<"), "<"), "@"))
End Sub