Extract URL from a cell having =Hyperlink() formula applied to it

Question

I want to fetch the URL from a cell which has this formula applied to it.

=HYPERLINK(CONCATENATE("https://loremipsum.com/#/Advertiser/",[@[Customer CID]],"/.html"), "View")

The formula has a structured reference to one of the columns in my sheet, 'Customer CID'.

When I try to apply this macro to my sheet it gives the default_value even when the formula is evaluating a correct URL.

Function GetURL(cell As Range, Optional default_value As Variant)
      If (cell.Range("A1").Hyperlinks.Count <> 1) Then
          GetURL = default_value
      Else
          GetURL = cell.Range("A1").Hyperlinks(1).Address
      End If
End Function

But when I do not apply the formula and add a Hyperlink to the cell by right-clicking the cell, the macro funtion =GetUrl([@[Customer CID]], "") works and gives me the URL.

Does anyone know how can I perform this task to fetch Hyperlink from a cell if that cell is evaluating the hyperlink from a formula ??

Answer 1

There's no direct way of getting the URL from a cell with a hyperlink generated by a formula. You need to extract the first argument from the HYPERLINK() function, and manually evaluate it.

This is the modified version of your code that does this:

Function GetURL(cell As Range, Optional default_value As Variant)
  With cell.Range("A1")
    If .Hyperlinks.Count = 1 Then
      GetURL = .Hyperlinks(1).Address
    Else
      If Left$(Replace(Replace(Replace(.Formula, " ", ""), vbCr, ""), vbLf, ""), 11) = "=HYPERLINK(" Then
        Dim idxFirstArgument As Long: idxFirstArgument = InStr(.Formula, "(") + 1
        GetURL = Evaluate(Mid$(.Formula, idxFirstArgument, InStrRev(.Formula, ",") - idxFirstArgument))
      Else
        GetURL = default_value
      End If
    End If
  End With
End Function

Note that any extraneous spaces, or added line breaks in the formula are properly accounted for.

Caveats:

• This will only work on formulas with an outermost HYPERLINK() function. (However, every formula can be refactored so that HYPERLINK() is outermost, with only a minor drawback; alternately all formulas can be refactored to one of the forms =IF(…,…,HYPERLINK()) or =HYPERLINK(), with no drawbacks, and only requiring a minor modification to the code; finally, with quite a bit of effort, code could be written to parse any formula no matter where the HYPERLINK() function is situated.);
• If there are any commas after the comma delimiting the first and second arguments of the HYPERLINK() function, the code will break (can be fixed relatively easily).

Answer 2

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