Get all email addresses from a single cell

Question

I need, with an Excel formula or VBA code, to get all email addresses from a single cell of text (before) and make them separated per row (after).

Example:

Agent1 agent.1@company.com Agent2 agent.2@company.com Agent3 agent.3@company.com Agent4 agent.4@company.com

Answer 1

Extract Email from Cell

Use the 2nd Sub to get the email addresses, use the 3rd to get the agents, too.

Option Explicit

Sub getEmail(SourceCell As String, FirstTargetCell As String, _
  Optional Both As Boolean = False)

    Dim Source() As String, Email() As String, Agent() As String
    Dim i As Long, e As Long, a As Long

    Source = Split(Range(SourceCell))

    For i = 0 To UBound(Source)
        If InStr(1, Source(i), "@") > 0 Then
            GoSub writeEmail
        Else
            If Both Then GoSub writeAgent
        End If
    Next i

    If Both Then
        If a > 0 Then
            Range(FirstTargetCell).Resize(UBound(Agent) + 1) = _
              Application.Transpose(Agent)
        End If
    End If
    If e > 0 Then
        Range(FirstTargetCell).Offset(, Abs(Both)).Resize(UBound(Email) + 1) = _
            Application.Transpose(Email)
    End If

    If a + e > 0 Then
        MsgBox "Operation finished successfuly.", vbInformation
    Else
        MsgBox "Didn't find anything.", vbExclamation
    End If

GoTo exitProcedure:

writeEmail:
    ReDim Preserve Email(e)
    Email(e) = Source(i)
    e = e + 1
Return

writeAgent:
    ReDim Preserve Agent(a)
    Agent(a) = Source(i)
    a = a + 1
Return

exitProcedure:

End Sub

Sub getEmailOnly()
    Const SourceAddress As String = "A2"
    Const TargetAddress As String = "A6"
    getEmail SourceAddress, TargetAddress
End Sub

Sub getAgentAndEmail()
    Const SourceAddress As String = "A2"
    Const TargetAddress As String = "A6"
    getEmail SourceAddress, TargetAddress, True
End Sub

Answer 2

Or,

In A6, formula copied down until blank :

=TRIM(MID(SUBSTITUTE(" "&$A$2," ",REPT(" ",399)),ROW(A1)*789,399))

Answer 3

one can use FILTERXML:

If one has Dynamic Array formula then just put this in the first cell and Excel will spill the results down.

=FILTERXML("<a><b>"&SUBSTITUTE(A2," ","</b><b>")&"</b></a>","//b[contains (.,'@')]")

---

If one does not have the dynamic array formula then wrap in INDEX and copy down:

=INDEX(FILTERXML("<a><b>"&SUBSTITUTE($A$2," ","</b><b>")&"</b></a>","//b[contains (.,'@')]"),ROW(ZZ1))

---

And if one does not have FILTERXML then we can use:

=INDEX(TRIM(MID(SUBSTITUTE($A$2," ",REPT(" ",999)),(ROW($ZZ$1:INDEX($ZZ:$ZZ,LEN($A$2)-LEN(SUBSTITUTE($A$2," ",""))+1))-1)*999+1,999)),AGGREGATE(15,7,ROW($ZZ$1:INDEX($ZZ:$ZZ,LEN($A$2)-LEN(SUBSTITUTE($A$2," ",""))+1))/(ISNUMBER(SEARCH("@",MID(SUBSTITUTE($A$2," ",REPT(" ",999)),(ROW($ZZ$1:INDEX($ZZ:$ZZ,LEN($A$2)-LEN(SUBSTITUTE($A$2," ",""))+1))-1)*999+1,999)))),ROW($ZZ1)))

This is an array formula that needs to be confirmed with Ctrl-Shift-Enter instead of Enter when exiting edit mode.