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