PDA

View Full Version : Solved: Getting Hyperlink from cell



SeanJ
09-18-2007, 11:42 AM
I need help with getting the hyperlink address from Column A and making a text value in Column C

Option Explicit
Sub findALink()
Dim strcell As String
Dim i As Long
Dim iLastRow As Long
With ActiveSheet
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To iLastRow
strcell = "C" + Trim(Str(i))
If Range(strcell).Value = "" Then

.Cells(i, "C").Value = .Cells(i, "A").Hyperlinks.Address

End If

Next i
End With
End Sub

Thanks

mdmackillop
09-18-2007, 12:45 PM
I'm not clear of your code function, but here's the basic syntax
hAdd = ActiveSheet.Name & "!A" & i
.Cells(i, "C").Hyperlinks.Add Anchor:=.Cells(i, "C"), Address:="", SubAddress:= _
hAdd, TextToDisplay:=hAdd

SeanJ
09-18-2007, 02:32 PM
Sorry I was tired and in a rush. I have in Column "A" a word that is hyperlinked to somewhere on our intranet. So in column "C" if that cell is blank then take the hyperlink address of the cell in column "A" and add it the cell of column "C" as text only.

So if A3 cell is book1 with hyperlink of

http://www.cnn.com

So C3 should say this

http://www.cnn.com

Just text only no hyperlinked.

Bob Phillips
09-18-2007, 03:18 PM
Option Explicit
Sub findALink()
Dim strcell As String
Dim i As Long
Dim iLastRow As Long
With ActiveSheet
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To iLastRow
strcell = "C" + Trim(Str(i))
If Range(strcell).Value = "" Then

On Error Resume Next
.Cells(i, "C").Value = .Cells(i, "A").Hyperlinks(1).Address
On Error Goto 0
End If
Next i
End With
End Sub

shasur
09-18-2007, 07:42 PM
Here is a way to check the links

Sub HLinks1()

For Each cell1 In Range("A:A").Hyperlinks
Range("C" & CStr(cell1.Range.Row)).Value = cell1.Range.Value
Next cell1

End Sub

SeanJ
09-19-2007, 04:26 AM
Thanks xld that did the trick. I going to run some test today with your code and other code that I have, and if all goes well I will mark this thread as solved after I finish this project.

SeanJ
09-19-2007, 09:15 AM
Got it working and thanks everyone