How do I code Excel VBA to retrieve the url/address of a hyperlink in a specific cell?

I am working on sheet2 of my workbook and it contains about 300 rows. Each rows have a unique hyperlink at column "AD". What I'm trying to go for is to loop on each blank cells in column "J" and change it's value from blank to the hyperlink URL of it's column "AD" cell. I am currently using this code:

do while.... NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address On Error Resume Next GetAddress = Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks(1).Address On Error GoTo 0
loop

Problem with the above code is it always get the address of the first hyperlink because the code is .Hyperlinks(1).Address. Is there anyway to get the hyperlink address by range address like maybe sheet1.range("AD32").Hyperlinks.Address?

8

5 Answers

This should work:

Dim r As Long, h As Hyperlink
For r = 1 To Range("AD1").End(xlDown).Row For Each h In ActiveSheet.Hyperlinks If Cells(r, "AD").Address = h.Range.Address Then Cells(r, "J") = h.Address End If Next h
Next r

It's a bit confusing because Range.Address is totally different than Hyperlink.Address (which is your URL), declaring your types will help a lot. This is another case where putting "Option Explicit" at the top of modules would help.

Not sure why we make a big deal, the code is very simple

Sub ExtractURL() Dim GetURL As String For i = 3 To 500 If IsEmpty(Cells(i, 1)) = False Then Sheets("Sheet2").Range("D" & i).Value = Sheets("Sheet2").Range("A" & i).Hyperlinks(1).Address End If Next i
End Sub

My understanding from the comments is that you already have set the column J to a string of the URL. If so this simple script should do the job (It will hyperlink the cell to the address specified inside the cell, You can change the cell text if you wish by changing the textToDisplay option). If i misunderstood this and the string is in column AD simply work out the column number for AD and replace the following line:

fileLink = Cells(i, the number of column AD)

The script:

Sub AddHyperlink()
Dim fileLink As String
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 4 To lastrow fileLink = Cells(i, 10) .Hyperlinks.Add Anchor:=Cells(i, 10), _ Address:=fileLink, _ TextToDisplay:=fileLink
Next i
End With
Application.ScreenUpdating = True
End Sub

Try to run for each loop as below:

do while.... NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address On Error Resume Next **for each** lnk in Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks GetAddress=lnk.Address next
On Error GoTo 0
loop

2

This IMO should be a function to return a string like so.

Public Sub TestHyperLink() Dim CellRng As Range Set CellRng = Range("B3") Dim HyperLinkURLStr As String HyperLinkURLStr = HyperLinkURLFromCell(CellRng) Debug.Print HyperLinkURLStr
End Sub

---

Public Function HyperLinkURLFromCell(CellRng As Range) As String HyperLinkURLFromCell = CStr(CellRng.Hyperlinks(1).Address)
End Function

Your Answer

Sign up or log in

Sign up using Google Sign up using Facebook Sign up using Email and Password Submit

Post as a guest

Post Your Answer Discard

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy