Copy hyperlink from one cell to/as hyperlink in another cell

Y

YogS

Hello

I have some tabular data,
With column A containing number, 1 to 10
With coumn B containing some names opposite to each number in column A

Each Number in column A points to its own webpage link.
I want to copy these hyperlink to/as hyperlink to respective name in
column B

Any ideas how can i achieve this

Regards
 
Y

YogS

Hello All
Probably my question was not clear

I have data like
No. ID
1 dts0100309695
2 dts0100309692
3 dts0100309688
4 dts0100309338
5 dts0100309323
6 dts0100309313
7 dts0100309310
8 dts0100309235
9 dts0100309229
10 dts0100309204
11 dts0100292049


The data under column "No." contains hyperlink. I want to copy
hyperlink from entries in column "No." as hyperlink to corresponding
entry in Column "ID"

eg if entry "1" in column "No." contain underlying hyperlink "
www.google.com" I want to copy this hyperlink as hyperlink to
corresponding entry "dts0100309695" in column ID

Regards
YogS
 
D

David McRitchie

How about an event macro invoked by a double-click , the
following macro will use the object type hyperlink of the
cell in the first column of the same row.

Install by rightclick on sheet tab, view code, insert the following:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
On Error Resume Next
ActiveWorkbook.FollowHyperlink Address:=Cells(Target.Row, 1).Hyperlinks(1).Address, _
NewWindow:=False, AddHistory:=True
If Err.Number <> 0 And Err.Number <> 9 Then
MsgBox Err.Number & " " & Err.Description
End If
End Sub
 
Y

YogS

Hi All,

Finally I was able to write a SUB which copies hyperlink from one cell
to/as hyperlink of another cell
But this code fails if source cell doesn't contains hyperlinks

Incidently this is my very first VBA introduction. So can any one guide
me how to check if cell do contains hyperlink & skip if it doesnot
contains hyperlinks

Sub copyHyperlink()
r = Selection.Rows.Count
For i = 1 To r
ActiveSheet.Hyperlinks.Add Anchor:=Selection.Cells(i, 2), _
Address:=Selection.Cells(i, 1).Hyperlinks(1).Address
Next
End Sub

Regards
YogS
 
D

David McRitchie

To check beforehand check if hyperlink.count = 0

Sub copyHyperlink()
Dim r As Long, i As Long
r = Selection.Rows.Count
For i = 1 To r
If Selection.Cells(i, 1).Hyperlinks.Count <> 0 Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection.Cells(i, 2), _
Address:=Selection.Cells(i, 1).Hyperlinks(1).Address
if trim(selection.cells(i,2)) = "" then
Selection.Cells(i, 2).Value = Selection.Cells(i, 1).Value
End If
End If
Next
End Sub


If you are satisfied with the way that your macro works then
you can include On error resume next
Which would do nothing if an error occurs.

If you want to check for the hyperlink ahead of time in your macro



Sub copyHyperlink()
Dim r As Long, i As Long
r = Selection.Rows.Count
For i = 1 To r
On Error Resume Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection.Cells(i, 2), _
Address:=Selection.Cells(i, 1).Hyperlinks(1).Address
If Err.Number = 0 And Selection.Cells(i, 2).Value = "" Then
Selection.Cells(i, 2).Value = Selection.Cells(i, 1).Value
End If
on error goto 0 'restore normal error
Next
End Sub

However I think the event macro that I provided before would be
less likely to cause problems since you intend to use the link
in one cell for other cells on the row.

Some links of interest:
http://www.mvps.org/dmcritchie/excel/buildtoc.htm
 
Top