hyperlink copy paste

[Jack]

Hi everyone.
There is a text on a cell and hyperlink of a website linked to it.
I would like to have a macro so that when I chose the cell and run the
macro, it reads what the hyperlink is and replace the text in the cell with
the actual web address that the hyperlink has.
I can do the same by right clicking and chosing edit hyperlink, then copy
the hyperlink and paste it.
But there are hundreds of cells like this so I need a macro for it.
Can anyone help?

 

[Gary''s Student]

Select cells with hyperlinks and run:

Sub ChangeFriendly()
Dim r As Range
For Each r In Selection
With r.Hyperlinks(1)
.TextToDisplay = .Address
End With
Next
End Sub

 

[Rick Rothstein]

First off, you missed the "dot" in front of the TextToDisplay property.
Second, you do NOT want to range over all the cells on the ActiveSheet... at
minimum, using your approach, I would restrict the range to the
ActiveSheet.UsedRange range of cells. However, even that is processing way
too many cells. Just loop through the hyperlinks themselves...

Sub ChangeFriendly()
Dim H As Hyperlink
For Each H In ActiveSheet.Cells.Hyperlinks
H.TextToDisplay = H.Address
Next
End Sub

 

[Rick Rothstein]

I believe in most cases there is little difference between Cells and

UsedArrea. VBA wil not go outside the used area unless data on the
worksheet at one time outside the used area that was deleted.

That is simply not true. Yes, certain Excel functions and methods won't look
outside of the UsedRange, but if you set up a loop to iterate all the cells
on the worksheet, then VB will iterate all the cell on the worksheet (after
all, how would it know you don't intend to do something with a cell
currently not in the UsedRange).. Here is your code modified to maintain a
counter (just to make sure you won't have to wait too long) and when the
counter reaches 500, it will display the counter value and the cell it is
currently at. Run this code on a blank sheet (UsedRange being nothing) and
watch the cell value that is displayed... it will be a value outside of the
UsedRange.

Sub ChangeFriendly()
Dim r As Range, Counter As Long, TextToDisplay As String
For Each r In ActiveSheet.Cells
' ************** Start Added Code **************
Counter = Counter + 1
If Counter >= 500 Then
MsgBox Counter & " - " & r.Address
Exit For
End If
' ************** End Added Code **************
If r.Hyperlinks.Count > 0 Then
With r.Hyperlinks(1)
TextToDisplay = .Address
End With
End If
Next
End Sub