Open Hyperlinks Using VBA in Excel (Runtime Error 9) - vba

Question

I am trying to use VBA to open hyperlinks from my excel using the following code:
numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
ActiveSheet.Range("E" & numRow).Hyperlinks(1).Follow
numRow = numRow + 1
Loop
However, I keep getting Runtime Error 9: Subscript out of range at the point in the code where I follow the hyperlinks.
I'm pretty new to VBA Macro-making (as in-'never done it before'), so help would be appreciated. (And if there's a better way to open a link from each cell in a single column, I'd appreciate learning about that too)
EDIT (To add more Info)
The hyperlink in question has been created using HYPERLINK Worksheet function and the text does not display the link URL. Sample of worksheet data is something like this:
What It Looks Like
Case ------ Link
Case1----- Summary
Case2----- Summary
Case3----- Summary
The Cells showing the text "Summary", however, contain a formula
=HYPERLINK("whateverthebaseurlis/"&[#[Case]]&"/Summary", "Summary")
And this is the link that has to be followed. The link works, it can be followed manually. But I need to do it via macro
Thanks

Answer 1

Probably, you are getting error because you have some cells with text but no link!
Check for link instead of whether or not cell is text:
numRow = 1
Do While ActiveSheet.Range("E" & numRow).Hyperlinks.Count > 0
ActiveSheet.Range("E" & numRow).Hyperlinks(1).Follow
numRow = numRow + 1
Loop

Answer 2

If it is throwing the error where you try to open hyperlinks, try and explictly open it using explorer.exe
Shell "explorer.exe " & Range("E" & numRow).Text
the reason Hyperlinks(1).Follow not working is that is no conventional hyperlink in the cell so it will return out of range
numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
URL = Range("E" & numRow).Text
Shell "C:\Program Files\Internet Explorer\iexplore.exe " & URL, vbNormalNoFocus
numRow = numRow + 1
Loop
Check this post for a similar problem:
http://www.mrexcel.com/forum/excel-questions/381291-activating-hyperlinks-via-visual-basic-applications.html

Answer 3

TRIED AND TESTED
Assumptions
I am covering 3 scenarios here as shown in the Excel file.
=HYPERLINK("www."&"Google"&".Com","Google"). This hyperlink has a friendly name
www.Google.com Normal hyperlink
=HYPERLINK("www."&"Google"&".Com") This hyperlink doesn't have a friendly name
Screenshot:
Logic:
Check what kind of hyperlink is it. If it is other than which has a friendly name then the code is pretty straightforward
If the hyperlink has a friendly name then what the code tries to do is extract the text "www."&"Google"&".Com" from =HYPERLINK("www."&"Google"&".Com","Google") and then store it as a formula in that cell
Once the formula converts the above text to a normal hyperlink i.e without the friendly name then we open it using ShellExecute
Reset the cell's original formula
Code:
Private Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal Operation As String, _
ByVal Filename As String, Optional ByVal Parameters As String, _
Optional ByVal Directory As String, _
Optional ByVal WindowStyle As Long = vbMinimizedFocus _
) As Long
Sub Sample()
Dim sFormula As String
Dim sTmp1 As String, sTmp2 As String
Dim i As Long
Dim ws As Worksheet
'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Sheets(1)
i = 1
With ActiveSheet
Do While WorksheetFunction.IsText(.Range("E" & i))
With .Range("E" & i)
'~~> Store the cells formula in a variable for future use
sFormula = .Formula
'~~> Check if cell has a normal hyperlink like as shown in E2
If .Hyperlinks.Count > 0 Then
.Hyperlinks(1).Follow
'~~> Check if the cell has a hyperlink created using =HYPERLINK()
ElseIf InStr(1, sFormula, "=HYPERLINK(") Then
'~~> Check if it has a friendly name
If InStr(1, sFormula, ",") Then
'
' The idea here is to retrieve "www."&"Google"&".Com"
' from =HYPERLINK("www."&"Google"&".Com","Google")
' and then store it as a formula in that cell
'
sTmp1 = Split(sFormula, ",")(0)
sTmp2 = "=" & Split(sTmp1, "HYPERLINK(")(1)
.Formula = sTmp2
ShellExecute 0, "Open", .Text
'~~> Reset the formula
.Formula = sFormula
'~~> If it doesn't have a friendly name
Else
ShellExecute 0, "Open", .Text
End If
End If
End With
i = i + 1
Loop
End With
End Sub

Answer 4

A cleaner way of getting cells hyperlinks:
Using Range.Value(xlRangeValueXMLSpreadsheet), one can get cell hyperlink in XML. As so, we only have to parse XML.
'Add reference to Microsoft XML (MSXML#.DLL)
Function GetHyperlinks(ByVal Range As Range) As Collection
Dim ret As New Collection, h As IXMLDOMAttribute
Set GetHyperlinks = ret
With New DOMDocument
.async = False
Call .LoadXML(Range.Value(xlRangeValueXMLSpreadsheet))
For Each h In .SelectNodes("//#ss:HRef")
ret.Add h.Value
Next
End With
End Function
So you can use this function in your code as this:
numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
FollowHyperlink GetHyperlinks(ActiveSheet.Range("E" & numRow))
numRow = numRow + 1
Loop
If you don't need numRow, you can just:
Dim h as String
For Each h In GetHyperlinks(ActiveSheet.Range("E:E"))
FollowHyperlink h
Next
For FollowHyperlink, I suggest below code - you have other options from another answers:
Sub FollowHyperlink(ByVal URL As String)
Shell Shell "CMD.EXE /C START """" """ & URL & """"
End Sub