Select Cell after Mouse-rollover Hyperlinks

Question

Description

I am experimenting with mouse-rollover events. On a sheet I have the following layout:

In column A, there are 3 named ranges: RegionOne which is A2:A4 RegionTwo which is A5:A7 and RegionThree which is A8:A10. These Range Names are listed in C1:C3. In D1:D3 I have the following formula:

=IFERROR(HYPERLINK(ChangeValidation(C1)),"RegionOne") (C1 changes to C2, C3 in D2, D3)

Cell F1 is a named range: NameRollover. Cell F2 is a Data Validation cell where Allow: = source that changes according to code execution.

Purpose

When a user rolls the mouse over the range D1:D3 the following happens:

1. The cell is highlighted according to a Conditional Format
2. Cell F1 (NameRollover) changes to the highlighted cell content
3. Cell F2 Data Validation changes the source to the Named Range that matches the value in Cell F1
4. Cell F2 is populated with the first entry of the data validation list

This is achieved by using the following Private Sub on Sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyList As String
If Not Intersect(Range("F1"), Target) Is Nothing Then
 
 With Sheet1.Range("F2")
    .ClearContents
    .Validation.Delete
    MyList = Sheet1.Range("F1").Value
    .Validation.Add Type:=xlValidateList, Formula1:="=" & MyList
End With

Sheet1.Range("F2").Value = Sheet1.Range(MyList).Cells(1, 1).Value

End If
End Sub

And by using the following Function (in a standard module)

Public Function ChangeValidation(Name As Range)
Range("NameRollover") = Name.Value
End Function

Everything works perfectly, except…

I would like, after the rollover action, for the data validation cell (F2) to become the “active” cell. At the moment, the user has to select that cell unless it already is the active cell. To try and achieve this, I have tried each of the following at the end of the Private Sub before the End If:

Application.Goto Sheet1.Range("F2")
Sheet1.Range("F2").Select
Sheet1.Range("F2").Activate

None of which works.

Question

How can I get the focus to shift at the end of the Private Sub execution to the cell of my choice – in this case F2? All suggestions are welcome.

Answer 1

Further to Tim's and my comments above, it is not possible to select a cell when you run a procedure through HYPERLINK method. Having said that, I have managed to find an alternative if you are interested. This doesn't use the HYPERLINK method but relies completely on two mouse APIs. GetCursorPos API and SetCursorPos API.

Logic

1. Find the mouse cursor position.
2. Find the range directly under the mouse cursor.
3. Format/Update/Select relevant cells.

Pros:

1. Doesn't rely on updating/formatting/Selecting a cell from inside an UDF.
2. Does what you want without the need of helper column (Col D).
3. You can bypass the F1 cell also if you want and directly take the values from C1:C3. In the below example I am however using F1.

Cons:

1. One has to Start and Stop the process.
2. One can see slight screen flickering when the mouse is over range C1:C3.

Test Conditions

For testing purpose, I have created a sample worksheet which looks like this

There are two Form Control Buttons which are bound to StartTracking() and StopTracking() using Assign Macro

Code:

Paste this in a module. We would not need the Worksheet_Change event anymore.

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
  
Type POINTAPI
    Xcoord As Long
    Ycoord As Long
End Type

Dim StopProcess As Boolean
Dim ws As Worksheet

'~~> Start Tracking
Sub StartTracking()
    StopProcess = False
    TrackMouse
End Sub

'~~> Stop Tracking
Sub StopTracking()
    StopProcess = True
End Sub

Sub TrackMouse()
    Set ws = Sheet1
    
    '~~> This is the range which has the names of named range
    Dim trgtRange As Range
    Set trgtRange = ws.Range("C1:C3")
    
    Dim rng As Range
    Dim mouseCord As POINTAPI
    
    Do
        '~~> Get the current cursor location and try to find the
        '~~> range under the cursor
        GetCursorPos mouseCord
        Set rng = Nothing
        Set rng = GetRangeUnderMousePosition(mouseCord.Xcoord, mouseCord.Ycoord)
            
        '~~> Check if the cursor is above C1:C3
        If Not rng Is Nothing Then
            If Not Intersect(trgtRange, rng) Is Nothing Then
                UpdateAndFormat rng
                
                Application.Cursor = xlDefault
            End If
        End If
        
        DoEvents '<~~ Do not uncomment or remove this
        
        If StopProcess = True Then Exit Do
    Loop
End Sub

'~~> Get the range under the cursor
Function GetRangeUnderMousePosition(x As Long, y As Long) As Range
    On Error Resume Next
    Set GetRangeUnderMousePosition = ActiveWindow.RangeFromPoint(x, y)
    On Error GoTo 0
End Function

'~~> Update and format cells F1/F2
Private Sub UpdateAndFormat(rng As Range)
    ws.Range("NameRollover").Value = rng.Value2
    
    With ws.Range("F2")
        .ClearContents
        .Validation.Delete

        .Validation.Add Type:=xlValidateList, Formula1:="=" & _
        ws.Range("NameRollover").Value2
        
        .Value = ws.Range(ws.Range("NameRollover").Value2).Cells(1, 1).Value
        
        Application.ScreenUpdating = False '<~~ To minimize showing the busy cursor
        .Select
        Application.ScreenUpdating = True
        
        '~~> Optional. Feel free to uncomment the below
        '~~> Move the cursor over cell F2. If it stays over C1:C3 then you will
        '~~> get busy cursor icon
        'SetCursorPos _
        ActiveWindow.ActivePane.PointsToScreenPixelsX(.Left + (.Width / 2)), _
        ActiveWindow.ActivePane.PointsToScreenPixelsY(.Top + (.Height / 2))
    End With
End Sub

In Action

Sample File

Mouse over Example

Disclaimer

I have not completely tested this file and may have bugs. Please ensure you have closed all important work before playing with this file.