View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.worksheet.functions
David McRitchie
 
Posts: n/a
Default Copy hyperlink from one cell to/as hyperlink in another cell

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

---
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

"YogS" wrote in message oups.com...
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