Use this VBA function to extract the URL from a cell in Excel. This versatile VBA function works whether the hyperlink is entered in Excel using the “=HYPERLINK()” function or the “Insert > Hyperlink” menu. To top it off, the function can be called from another VBA macro or it can be entered as a formula directly into another cell in Excel. That’s what makes this function different from other solutions you may find online.

Extracting a URL from an existing hyperlink is great when you want to interactively open the URL in your default browser or use VBA to scrape data from a website.

This helpful macro was submitted by a member of the wellsrPRO community, Mitch! Thank you, Mitch!


Macro to extract the URL from a cell

Created by Mitch

Function LinkLocation(rng As Range)
'DESCRIPTION: Get the formula url from hyperlink/formula or the insert/hyperlink method
'DEVELOPER: Mitch (wellsrPRO member)

    ' vars
    Dim sFormula As String, sAddress As String
    Dim L As Long
    Dim sHyperlink As Hyperlink, rngHyperlink As Hyperlinks
    
    ' cell formula
    sFormula = rng.Formula
    
    ' gets starting position of the file path. Also acts as a test if
    ' there is a formula
    L = InStr(1, sFormula, "HYPERLINK(""", vbBinaryCompare)

    ' tests for hyperlink formula and returns the address. If a link
    ' then returns the link location.
    If L > 0 Then
        sAddress = Mid(sFormula, L + 11)
        sAddress = Left(sAddress, InStr(sAddress, """") - 1)
    Else
        Set rngHyperlink = rng.Worksheet.Hyperlinks
        For Each sHyperlink In rngHyperlink
            If sHyperlink.Range = rng Then
                sAddress = sHyperlink.Address
            End If
        Next sHyperlink
    End If
    
    ' boom, got the hyperlink address
    LinkLocation = sAddress

End Function

Make powerful macros with our free VBA Developer Kit

It’s easy to copy and paste a macro like this, but it’s harder make one on your own. To help you make macros like this, we built a free VBA Developer Kit and wrote the Big Book of Excel VBA Macros full of hundreds of pre-built macros to help you master file I/O, arrays, strings and more - grab your free copy below.

I'll take a free VBA Developer Kit

How to use the LinkLocation Macro

You can call the LinkLocation function both from a cell in Excel and from your VBA editor. Before we demonstrate both methods, let’s pretend you have a spreadsheet with hyperlinks embedded in it, like this:

Excel Spreadsheet with Hyperlinks

These hyperlinks point to different URLs on the VBA Tutorials Blog and can be added using the “Insert > Hyperlink” menu, by right-clicking the cell and selecting “Hyperlink” or by using the native Excel =HYPERLINK() function, like this:

=HYPERLINK("https://wellsr.com/vba/vba-cheat-sheets/","Cheat Sheets")

It doesn’t matter how your user inserts the hyperlink, the LinkLocation VBA function will be able to extract it.

It’s important to point out the LinkLocation function accepts one argument and that argument should be a single cell. Trying to extract hyperlinks from a range with multiple cells by using this function will generate an error. If the cell you’re trying to extract the URL from doesn’t contain a hyperlink, the function will return an empty an string.

Calling the LinkLocation function using VBA

To call the LinkLocation function from another VBA subroutine, simply reference the function by name and set it equal to a string variable, like we do in this demo:

Sub ExtractURL()
Dim strURL As String
strURL = LinkLocation(Range("C3"))
Debug.Print strURL
End Sub

When you run this macro, the string https://wellsr.com/vba/vba-cheat-sheets/ is stored in the variable strURL. You can now do whatever you want with the URL, like using ShellExecute to open the URL in your default browser.

Notice how we only passed the LinkLocation function a single cell, rather than the entire range of cells C1:C4. We did this to avoid an error. You could easily modify the macro to extract all URLs in the range and store them to an array if you’d like.

Calling the LinkLocation function from Excel

If all you wanted to do was to find out where a cell hyperlinks to, you could call the LinkLocation function by placing a formula like this into a cell:

=LinkLocation(C4)

In our example above, this would return the URL https://wellsr.com/vba/add-ins/. This could be helpful if your spreadsheet had a bunch of hyperlinks and you wanted to avoid opening each one individually just to see where the hyperlinks point to.

Here’s what our extract URLs would look like if we placed our LinkLocation formulas into column D:

Extract URL from Excel Hyperlink

That’s all for this tutorial. When you’re ready to take your VBA to the next level, subscribe using the form below.