FollowHyperlink event - How to stop link from opening?

Question

I have a range of cells with data in the form:

"AAA;BBB;CCC"

where ideally I have to create a separate hyperlink for each of AAA, BBB and CCC. Since Excel allows for only one hyperlink per cell, I thought I could split the cell text and open up three webpages using 'ShellExecute' when a dummy hyperlink is clicked.

I created a hyperlink in the cell to "www.google.com" and wrote the following code in the 'FollowHyperlink' event handler:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim strArray() As String
    Dim strSamp As String

    strArray() = Split(ActiveCell.Text, ";")

    For i = LBound(strArray) To UBound(strArray)
       strSamp = "www." + strArray(i) + ".com"
       lSuccess = ShellExecute(0, "Open", strSamp)
       MsgBox (strSamp)
    Next i
End Sub

Every time I click on the cell, the browser opens Google and the Message Boxes are not displayed.

I cannot figure out where I am going wrong in my logic. I would appreciate any insight any of you could give me.

Edit:

I rewrote the code in a fresh worksheet and the code is functioning as it should. The Message Boxes are displaying now and the individual hyperlinks are opening in the browser. But in addition to the individual links, the dummy link (in this case Google) is also opening. How do I stop it from opening?

Answer 1

I use the Worksheet_BeforeDoubleClick event for these kind of operations.

Let's say the text is in Cell A1. Try this.

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) As Long

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim strArray() As String, strSamp As String
    Dim i As Long

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        strArray = Split(Target.Value, ";")

        For i = LBound(strArray) To UBound(strArray)
            strSamp = "www." + strArray(i) + ".com"
            ShellExecute 0, "Open", strSamp, "", "", SW_SHOWNORMAL
            DoEvents
        Next i
        Cancel = True
    End If
End Sub

Edit:

Oops, I forgot to mention that you need to double click on cell A1 for this code to run :p

Note: If you want to still use the Worksheet_FollowHyperlink() method then hyperlink the cell to itself and not to a website. This will not launch the website and show your message boxes.