CODEWITHSUNDEEP
excelvbahyperlink
ekh64
ekh64

Reputation: 73

Extract URL From Excel Hyperlink Formula

I have an Excel file with hundreds of cells that use the Hyperlink formula =HYPERLINK( <targetURL>, <friendlyName> ). I need to extract the plain text URLs from these. Most examples that I've found rely on the cell using a different hyperlinking method.

So a function like this:

Function HyperLinkText(pRange As Range) As String

   Dim ST1 As String
   Dim ST2 As String

   If pRange.Hyperlinks.Count = 0 Then
      HyperLinkText = "not found"
      Exit Function
   End If

   ST1 = pRange.Hyperlinks(1).Address
   ST2 = pRange.Hyperlinks(1).SubAddress

   If ST2 <> "" Then
      ST1 = "[" & ST1 & "]" & ST2
   End If

   HyperLinkText = ST1

End Function

results in cell text "not found". Alternatively, is there a way of converting these cells to the other hyperlink format so that the macro I have works?

Upvotes: 7

Views: 17431

Answers (7)

ChrisB
ChrisB

Reputation: 3225

Other answers don't handle variations in the formula very well. For example, they fail if the formula contains both the LINK_LOCATION parameter and the FRIENDLY_NAME parameter. Others also fail if the formula has extra spaces or line breaks in certain areas.

This answer isn't perfect but it works better than other answers I have found as of the date I am posting this. I have identified cases where this code will work and where it will fail.

This VBA function is a bit long but it will extract the URL/address of a hyperlink either from a HYPERLINK() formula or a non-formula hyperlink imbedded in a cell.

It checks for a non-formula hyperlink first since that is the easiest and most reliably extracted hyperlink. If one doesn't exist it checks for a hyperlink in a formula.

Extraction from a formula ONLY works if there is nothing outside the HYPERLINK() function except an equal sign.

Acceptable HYPERLINK() Formulas

It WILL work on this formula:

=HYPERLINK("https://" & A1, "My Company Website")

It WILL work on this formula too (notice extra spaces and line breaks):

=    
HYPERLINK(     "https://" & A1, 
         "My Company Website" & B2)

It will NOT work on this formula:

=IF(  LEN(A1)=0, "", HYPERLINK("https://" & A1, "My Company Website")  )

Function

Function HyperLinkText(ByVal Target As Excel.Range) As String
    
    ' If TARGET is multiple cells, only check the first cell.
    Dim firstCellInTarget As Excel.Range
    Set firstCellInTarget = Target.Cells.Item(1)
    
    
    Dim returnString As String
    
    
    ' First check if the cell contains a non-formula hyperlink.
    If Target.Hyperlinks.Count > 0 Then
        ' Cell contains a non-formula hyperlink.
        returnString = Target.Hyperlinks.Item(1).Address    ' extract hyperlink text from the Hyperlinks property of the range
    
    Else
        ' Cell does -NOT- contain a non-formula hyperlink.
        '   Check for a formula hyperlink.
        Dim targetFormula As String
        targetFormula = firstCellInTarget.Formula
        
        
        
        Dim firstOpenParenthesisIndex As Long
        firstOpenParenthesisIndex = VBA.InStr(1, _
                                              targetFormula, _
                                              "(", _
                                              VbCompareMethod.vbBinaryCompare)
        
        Dim cleanFormulaHyperlinkPrefix As String
        cleanFormulaHyperlinkPrefix = Left$(targetFormula, firstOpenParenthesisIndex)
        cleanFormulaHyperlinkPrefix = Replace$(Replace$(Replace$(cleanFormulaHyperlinkPrefix, Space$(1), vbNullString), vbCr, vbNewLine), vbLf, vbNullString)
        
        Dim cleanFormulaPart2 As String
        cleanFormulaPart2 = Mid$(targetFormula, firstOpenParenthesisIndex + 1)
        
        Dim cleanFormulaCombined As String
        cleanFormulaCombined = cleanFormulaHyperlinkPrefix & cleanFormulaPart2
        
        
        ' Get all text inside the HYPERLINK() function.
        '   This is either a single LINK_LOCATION parameter or both the
        '   LINK_LOCATION and FRIENDLY_NAME parameters separated by a comma.
        '
        '   Ex. 1 Parameter:        "https://" & $A$1
        '   Ex. 2 Parameters:       "https://" & $A$1, "Click Here To Open the Company URL"
        '
        Const HYPERLINK_FORMULA_PREFIX As String = "=HYPERLINK("
                
        Dim tmpString As String
        tmpString = Mid$(cleanFormulaCombined, VBA.Len(HYPERLINK_FORMULA_PREFIX) + 1)
        
        Dim textInsideHyperlinkFunction As String
        textInsideHyperlinkFunction = Left$(tmpString, VBA.Len(tmpString) - 1)
        
        
        ' Get the first parameter (LINK_LOCATION) from the text inside the HYPERLINK()
        '   function by using =EVALUATE().  If text inside the HYPERLINK() function
        '   contains two parameters, they will be separated by a comma and EVALUATE()
        '   will return an error.  Start with the entire text inside the HYPERLINK()
        '   function.  If EVALUATE() returns an error, remove one character from the end
        '   of the string being evaluated and try again.  Eventually only one parameter
        '   will be evaluated and EVALUATE() will return a text string.
        '
        '   For example, if the string to be evaluated is:
        '
        '       "https://" & $A$1, "Click Here To Open the Company URL"
        '
        '   and cell A1 contains:
        '
        '       mycompany.com
        '
        '   EVALUATE will return:
        '
        '       https://mycompany.com
        '
        Dim hyperlinkLinkLocation As String
        Dim i As Long
        For i = VBA.Len(textInsideHyperlinkFunction) To 1 Step -1   ' with each failure, shrink length of string-to-evaluate by one

            If Not VBA.IsError(Excel.Application.Evaluate("=" & Left$(textInsideHyperlinkFunction, i))) Then
                hyperlinkLinkLocation = Excel.Application.Evaluate("=" & Left$(textInsideHyperlinkFunction, i))
                Exit For        ' ****
            End If

        Next i
        
        returnString = hyperlinkLinkLocation

    End If
    
    
    ' Return the hyperlink string.
    HyperLinkText = returnString
End Function

How to Use the Function

Sub Test()
    ' Display hyperlink of the first cell
    '    in the currently selected range.
    Msgbox HyperLinkText(Selection) ' displays the hyperlink of the first cell
End Sub

Upvotes: 0

Shahid Saddique
Shahid Saddique

Reputation: 11

Here is an Excel formula that can extract URL from a hyperlink used into cell.

A1= Excel Cell where you want to extract URL.

=MID(FORMULATEXT(A1),FIND(CHAR(34),FORMULATEXT(A1))+1,FIND(CHAR(34),FORMULATEXT(A1),FIND(CHAR(34),FORMULATEXT(A1))+1)-1-FIND(CHAR(34),FORMULATEXT(A1)))

Image for reference.

Excel Formula to get URL from excel hyperlink

Upvotes: 0

Ash
Ash

Reputation: 3550

I ended up using Python:

  1. Download (or convert) the spreadsheet into xlsx format.
  2. Install openpyxl using pip or conda.

  3. Read the xlsx with a code similar to:

    from openpyxl import load_workbook
wb = load_workbook(filename = 'cities.xlsx')
print(wb.worksheets)
print(dir(wb))
sheet_ranges = wb['Sheet1']
for c in sheet_ranges['B']:
    print(c.hyperlink.target)

Note that the name 'Sheet1' or column names might be different case by case ('B' is the column with hyperlink in my case).

  1. After the links are printed copy them and paste them into a new column in your sheet.

Upvotes: 0

pnuts
pnuts

Reputation: 59495

Non-VBA possibility:

Work on copies of the cells with links because the first step is to replace part of their content (specifically = with I suggest the not sign ¬). Then, assuming the copy is in A1: 

=SUBSTITUTE(LEFT(MID(A1,13,LEN(A1)),FIND("""",MID(A1,13,LEN(A1)))-1),"¬","=")

and replace ¬ with = where the link contains an equals sign.

Upvotes: 0

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60494

Here is a method that will return the hyperlink text whether it has been created by a formula, or by the Insert/Hyperlink method.

If the former, we merely have to parse the formula; if the latter, we need to iterate through the hyperlinks collection on the worksheet.

The formula will return nothing if there is no hyperlink in cell_ref; change to suit.

Option Explicit
Function HyperLinkText(rg As Range)
    Dim sFormula As String, S As String
    Dim L As Long
    Dim H As Hyperlink, HS As Hyperlinks

sFormula = rg.Formula
L = InStr(1, sFormula, "HYPERLINK(""", vbBinaryCompare)

If L > 0 Then
    S = Mid(sFormula, L + 11)
    S = Left(S, InStr(S, """") - 1)
Else
    Set HS = rg.Worksheet.Hyperlinks
    For Each H In HS
        If H.Range = rg Then
            S = H.Address
        End If
    Next H
End If

HyperLinkText = S

End Function

Upvotes: 7

BruceWayne
BruceWayne

Reputation: 23285

Hm - playing around with it, I couldn't get .Address to work either.

You say you want to extract the URL only, I was able to do that with this macro:

Function hyperlinkText(pRange As Range) As String
Dim st1 As String, st2 As String
Dim tempSub1 As String, tempSub2 As String

If Left(pRange.Formula, 10) <> "=HYPERLINK" Then
    hyperlinkText = "not found"
    Exit Function
Else
    tempSub1 = WorksheetFunction.Substitute(pRange.Formula, """", "[", 1)
    tempSub2 = WorksheetFunction.Substitute(tempSub1, """", "]", 1)
    hyperlinkText = Mid(tempSub2, WorksheetFunction.Find("[", tempSub2) + 1, WorksheetFunction.Find("]", tempSub2) - WorksheetFunction.Find("[", tempSub2) - 1)
End If

End Function

Note though, it doesn't get the "Friendly Name" of the Hyperlink() formula, just the URL.

Upvotes: 1

Bond
Bond

Reputation: 16321

You could extract it with a regex:

Dim re
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "^=HYPERLINK\(""([^""]+)"""

If re.Test(pRange.Formula) Then
    Debug.Print "URL = " & re.Execute(pRange.Formula)(0).SubMatches(0)
Else
    Debug.Print "URL not found"
End If

This just checks to see if the formula begins with:

=HYPERLINK("

and, if so, grabs the text from that point until the following ".

Upvotes: 1

Related Questions