Extracting a email address for a macro

[Tim Chambers]

I have a rather extensive data base that I'd like to get the email addresses out of the persons name and actually display

i.e. Cell A1 has 'John Doe' as the data but if you go over it you get 'mailto:JohnDoe@TheInternet.com'

I want to extract his email address from A1 and place it in cell B1

When recording the macro I right clicked/hyperlink/copy hyperlink/paste
It worked great...however when I run the macro B1 just says John Doe with the the hyperlink if you go over the cell; just as the original cell A1

Thanks

 

[Norie]

Try this code.

Sub GetEmail()
Dim LastRow As Long
Dim I As Long
Dim rng As Range

    LastRow = Range("A65536").End(xlUp).Row
    
    For I = 2 To LastRow
    
        Set rng = Range("A" & I)
        
        rng.Offset(0, 1) = Mid(rng.Hyperlinks(1).Address, 8)
    Next I
End Sub

 

[Tim Chambers]

I ha

 

[Tim Chambers]

had to add an on error statement for those without emails, but other than that is worked great!!!


Thanks