Assistance requested

[rw-1]

Hello,

I'm a computer guru, but a newb to both excel and programming.

I have a spreadsheet (don't we all? ) which is sent to our company from another, which contains information (don't they all? )

I have a column which is nothing but mailto: links, the customers names which when clicked on would open the default users mail program inputting the email address into the recipient line.

What I would like to do, and perform, is to take the email address in that mailto, extract it somehow and then paste it into the next column so that I have their names still hyperlinked, but have the email address associated with their names next door so to speak.

I had tried a macro, but unfortunately it will nto record the goiong on outside of excel (where I was copying and pasting out of the recipient line on outlook).

Realizing this is beyond my capabilities, I turn to the community, whom in all endeavors I have ever asked, has not let me down yet.

To assist though, I can tell you I have files with rows varying into the 1200 range, and the mailto link column is K, the field I'd love to populate if this can be done would be column L (doh!).

Welll I hope someone more knowledable in excel can help me out, it won't take much, and if it cannot be done, well at least I believe I have come to the place to find that out.

Thanks in advance.

 

[Von Pookie]

Does this work for you?

Sub test()
Dim cell As Range, myRng As Range

Set myRng = Range("K1", Range("K65536").End(xlUp))

For Each cell In myRng
    'copy link from column K into column L
    ActiveSheet.Hyperlinks.Add anchor:=cell.Offset(, 1), _
    Address:=cell.Hyperlinks(1).Address
    
    'remove link from column K
    cell.Hyperlinks(1).Delete

Next cell
    
End Sub

 

[Von Pookie]

Actually, this may work out better.

Sub MoveLinks()
Dim cell As Range, myRng As Range

Set myRng = Range("K1", Range("K65536").End(xlUp))

For Each cell In myRng
    On Error Resume Next
    'copy link from column K into column L
    ActiveSheet.Hyperlinks.Add anchor:=cell.Offset(, 1), _
    Address:=cell.Hyperlinks(1).Address, _
    TextToDisplay:=Mid(cell.Hyperlinks(1).Address, 8)
   
    'remove link from column K
    cell.Hyperlinks(1).Delete

Next cell
   
End Sub

I changed it a teensy bit. With the original code, if it gets to a cell that doesn't have a hyperlink, it will display an error. I changed that so that if the cell in column K doesn't have a link, it will go onto the next cell instead of displaying an error and stopping everything.

Also, this version will change the displayed text to be the email address itself, removing only the "mailto:" portion of the link.