1

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

Shisa
  • 580
  • 3
  • 8
  • 21

4 Answers4

5

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
LS_ᴅᴇᴠ
  • 10,823
  • 1
  • 23
  • 46
  • Thanks, but that's not it. The hyperlinks are all valid (and are text) (I've checked manually) and I'm getting the same error even when I use something like `numRows < 10` as my conditional statement. And I'm getting the error at the line with Hyperlinks(1).Follow... – Shisa Sep 30 '13 at 08:02
  • Try `Debug.Print ActiveSheet.Range("E" & numRow).Hyperlinks.Count` instead of `.Follow` line. If you get anything less then `1`, your hyperlinks are not correct. Your cell may be formatted as a link, but not really linked. – LS_ᴅᴇᴠ Sep 30 '13 at 08:07
  • @LS_Dev Thanks, this does show the hyperlinks count as 0. Except, the links definitely work (like I said, I've checked them manually), but they've been created using text concatenation and the HYPERLINK function, and have a "friendly_name" gloss as well. What solution could I use in this case? – Shisa Sep 30 '13 at 08:16
1

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

manimatters
  • 424
  • 3
  • 11
  • Thanks, I think this is it, because the hyperlinks have been created using the HYPERLINK function with text concatenation from a stock url and a value from another cell in the row. BUT, now the problem is that the Hyperlink has a "friendly_name" in addition to link_location, so I can't use `.Text`, and using `.Hyperlinks(1).Address` gives me the same Runtime Error 9. :/ – Shisa Sep 30 '13 at 08:12
  • What is the value you are getting for `.Hyperlinks(1).Address`, before it throws the Error? – manimatters Sep 30 '13 at 08:17
1

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:

enter image description here

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
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
1

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
LS_ᴅᴇᴠ
  • 10,823
  • 1
  • 23
  • 46