Sub FollowFormulaHyperlink()
URL$ = GetCellHyperlinkAddress(ActiveCell)
CreateObject("WScript.Shell").Run URL$
End Sub
Function GetCellHyperlinkAddress(ByRef cell As Range, Optional AllowInactiveURL As Boolean = False) As String
On Error Resume Next
Dim v$
With cell.MergeArea.Hyperlinks(1)
GetCellHyperlinkAddress = .Address
If Len(GetCellHyperlinkAddress) Then
If Len(.SubAddress) Then GetCellHyperlinkAddress = GetCellHyperlinkAddress & "#" & .SubAddress
If GetCellHyperlinkAddress Like "..*" Then GetCellHyperlinkAddress = cell.Worksheet.Parent.Path & "\" & Replace(GetCellHyperlinkAddress, "/", "\")
Exit Function
End If
End With
Dim txt$, Brackets&, Quotes&, i&
If GetCellHyperlinkAddress = "" Then
If cell.Formula Like "=HYPERLINK*" Then
txt$ = Mid$(cell.Formula, 12)
txt$ = Left(txt, Len(txt) - 1)
For i& = 1 To Len(txt)
Select Case Mid(txt, i, 1)
Case "(": Brackets& = Brackets& + 1
Case ")": Brackets& = Brackets& - 1
Case """": Quotes& = Quotes& + 1
Case ","
If (Brackets& = 0) And (Quotes& Mod 2 = 0) Then
txt = Left(txt, i - 1)
Exit For
End If
End Select
Next
GetCellHyperlinkAddress = Evaluate(txt)
End If
End If
Err.Clear
End Function
