Excel VBA Errors while trying to extract emails addresses from a list

Question

While trying to extract email addresses from a spreadsheet in which the cells contain additional information (according to instructions at https://smallbusiness.chron.com/extract-email-addresses-excel-spreadsheet-42777.html ) I entered:

Function ExtractCellEmail(cell As Range) As String

    Dim contents As String contents = cell.Text

    AtPosition = InStr(1, contents, "@")
    AddressStartingPosition = InStrRev(contents, " ", AtPosition)
    AddressEndingPosition = InStr(AtPosition, contents, " ")
    AddressEndingPosition = InStr(AtPosition, contents, " ")
    ActiveCell.Offset(0, 1).Value = emailAddress

End Function

I received an error message that says

"Expected: end of statement"

For the sub function I entered

Sub Troyextract()
Sub mcrExtractColumnAddresses()

    Do
        Call ExtractEmails(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop Until IsEmpty(ActiveCell)

End Sub

I received an error message that said

"Expected End Sub"

Please help.

Troy

Answer 1

Does this need to be VBA? You can do this with a formula:

=IF(ISNUMBER(FIND("@",A1)),TRIM(RIGHT(SUBSTITUTE(LEFT(A1,FIND(" ",A1&" ",FIND("@",A1))-1)," ",REPT(" ",LEN(A1))),LEN(A1))),"")