Reputation: 73
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
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.
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 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
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
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.
Upvotes: 0
Reputation: 3550
I ended up using Python:
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).
Upvotes: 0
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
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
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
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