Open Hyperlinks Using VBA in Excel (Runtime Error

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

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

Answer 3

TRIED AND TESTED

Assumptions

I am covering 3 scenarios here as shown in the Excel file.

1. =HYPERLINK("www."&"Google"&".Com","Google"). This hyperlink has a friendly name
2. www.Google.com Normal hyperlink
3. =HYPERLINK("www."&"Google"&".Com") This hyperlink doesn't have a friendly name

Screenshot:

Logic:

1. Check what kind of hyperlink is it. If it is other than which has a friendly name then the code is pretty straightforward
2. 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
3. Once the formula converts the above text to a normal hyperlink i.e without the friendly name then we open it using ShellExecute
4. 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

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