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