Extracting Hyperlinks

[Steve M]

I have a spreadsheet containing several columns. One of which contains
Hyperlinks. It there a way of extracting the information within the
Hyperlink so I can copy it into another column

Thanx

Steve M

 

[keepITcool]

Steve, does this give you a start?

Sub ExtractHL()
Dim cel As Range

With ActiveWindow.RangeSelection
If .Columns.Count > 1 Then
MsgBox "Select 1 column only. Next column must be empty!"
Exit Sub
End If

For Each cel In .Columns(1).Cells
If cel.Hyperlinks.Count > 0 Then
cel(1, 2) = cel.Hyperlinks(1).Address
End If
Next
End With
End Sub


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[JWJW]

I have a similar problem.
I can extract hyperlinks entered into cells OK, but I have
spreadsheet that has a series of objects (pictures). The hyperlink i
in the object, not the cell, as I can drag and drop the objec
elsewhere. Each of these objects is one to a cell, in a column. If
right-click on the object, I can get the Hyperlink menu, and can Edi
the hyperlink if I want to. The trouble is, I have hundreds of thes
objects.

Is there some function that I can use or create to extract th
hyperlink from the object in each cell?

Thanks

 

[adam12+]

keepITcool,
Thanks for the great code. Very helpful in dealing w/ hyperlinks!!
Thanks,
Adam1

 

[David McRitchie]

See Extract and Place Hyperlink from Shape into cell to the right
http://www.mvps.org/dmcritchie/excel/shapes.htm#ExtractLinkToRightOfShapes
modified from a posting by Dick Kusleika

Sub ExtractLinkToRightOfShapes()
'Extract hyperlink and place to right of cells with shapes
'Dick Kusleika, 2003-03-26 in excel.links, modified from
' http://google.com/groups?threadm=efcLbz#[email protected]
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
On Error Resume Next
shp.BottomRightCell.Offset(0, 1).Value = "'--"
shp.BottomRightCell.Offset(0, 1).Value = shp.Hyperlink.Address
On Error GoTo 0
Next shp
End Sub

You can use TopLeftCell instead and you can check it as

if shp.TopLeftCell.Column = 5 then 'test for Column E
shp.BottomRightCell.Offset(0, 1).Value = shp.Hyperlink.Address
end if