Macro to double click cell A2 on Active Sheet once Drop down in A1 has been selected from Data Validation List

[howard]

Once a user has selected an item from the drop down in Cell A1 on the active sheet ("Adjustments using Data Validation , the user double clicks on A2 , which has a hyperlink formula, and it will then go to the appropriate cell

I tried to write code to do this, but it only goes to A2 and does not go to the appropriate cell for Eg A55

Kindly amend my code

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then 'Change "$A$1" to the cell address of your drop down list
        On Error Resume Next
        Dim hyperlink As hyperlink
        Set hyperlink = Range("A2").Hyperlinks(1) 
        On Error GoTo 0
        If Not hyperlink Is Nothing Then
            hyperlink.Follow
        End If
    End If
End Sub

 

[Jimmypop]

Hi there... Untested...

The current code only retrieves the hyperlink of A2 and follows it, but it does not update the hyperlink to point to the appropriate cell based on the value selected in cell A1. To accomplish this, you need to update the hyperlink formula of cell A2 to include the appropriate cell reference based on the value selected in A1.

Here is the updated code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then 'Change "$A$1" to the cell address of your drop-down list
        Dim hyperlink As Hyperlink
        Set hyperlink = Range("A2").Hyperlinks(1)
        hyperlink.Address = "#" & Range(Target.Value).Address(False, False, xlA1, True)
        hyperlink.Follow
    End If
End Sub

In this updated code, the hyperlink formula of A2 is updated to point to the appropriate cell based on the value selected in A1. The code retrieves the hyperlink object of A2, and then sets its address to the appropriate cell reference using the "#" character to indicate an internal link. Finally, the hyperlink is followed to navigate to the appropriate cell.

Note that this code assumes that the value selected in A1 corresponds to a valid cell reference in the same worksheet. You may need to add error handling to handle cases where the value in A1 is invalid or not recognized as a valid cell reference.

 

[howard]

Thanks for the help and explnation. I made a mitake. There is no double click. One I seelect the name use the drop down, I go to A2 and click on this cell and it then goes to the appropriate cell

I get subscript out of range when running the code and code below is highlighted

 Set hyperlink = Range("A2").Hyperlinks(1)

Kindly amend code

 

[Jimmypop]

Thank you for the clarification. If you are navigating to the appropriate cell by clicking on cell A2 after selecting an item from the drop-down list, you can modify the code to use the Worksheet_SelectionChange event instead of Worksheet_Change.

Here's the updated code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$A$2" Then 'Change "$A$2" to the cell address where you want to navigate after selecting an item from the drop-down list
        Dim hyperlink As Hyperlink
        Set hyperlink = Range("A2").Hyperlinks(1)
        hyperlink.Address = "#" & Range("Adjustments!" & Range("A1").Value).Address(False, False, xlA1, True)
        hyperlink.Follow
    End If
End Sub

In this updated code, the Worksheet_SelectionChange event is used to detect when the user clicks on cell A2. If A2 is clicked, the code retrieves the hyperlink object of A2 and sets its address to the appropriate cell based on the value selected in A1. The Follow method is then called to navigate to the appropriate cell.

Note that the code assumes that the sheet where the drop-down list is located is named "Adjustments". You may need to update the sheet name in the code if it is different in your workbook. Also, make sure that the value selected in A1 corresponds to a valid cell reference in the "Adjustments" sheet.

Regarding the "subscript out of range" error you are encountering, it could be caused by a hyperlink not being present in cell A2. To avoid this error, you can add error handling to check if a hyperlink exists before trying to retrieve it. Here's an updated code with error handling:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$A$2" Then 'Change "$A$2" to the cell address where you want to navigate after selecting an item from the drop-down list
        On Error Resume Next
        Dim hyperlink As Hyperlink
        Set hyperlink = Range("A2").Hyperlinks(1)
        On Error GoTo 0
        If Not hyperlink Is Nothing Then
            hyperlink.Address = "#" & Range("Adjustments!" & Range("A1").Value).Address(False, False, xlA1, True)
            hyperlink.Follow
        End If
    End If
End Sub

I hope this helps! Let me know if you have any further questions.

 

[howard]

Thanks for the help, but code still not working. When I do this manully, I select the Drop Down, Click on A1 aqnd then click On A2 and then it goes to the appropriate cell

 

[howard]

See Link Below of Sample Data So that this can assist you in seeing why your code is not giving the desired result

Macro to go to cell after Selecting Nme in Drop Down.xlsm

Shared with Dropbox

www.dropbox.com

Kindly Check & amend your code

 

[Jimmypop]

You need to make sure that your Date Months correspond to each other...

On sheet Months you have them listed as

Jan

Feb

March

Apr

May

Jun

Jul

Aug

Sep

Oct

Nov

Dec

However on the adjustments tab You have for example June not Jun, July not Jul and August not Aug....

When I update this then for example.... Name is Peter Rantfor



Then all updates are doen and it goes to A33 when click on A2

 

[howard]

Thanks for pointing this out

 

[Jimmypop]

Is it working now...

 

[Jaafar Tribak]

Set hyperlink = Range("A2").Hyperlinks(1) will always raise an error because you are using the Hyperlink function not an actual Hyperlink.

Clicking a cell programmatically can be tricky. I have tried using IUIAtomation and MSAA to perform the click on the cell but it didn't work.
Short of the more robust automation approach, the only alternative that I could think of was the win32 api.

See if this works for you:

In the Worksheet Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
#End If

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        ClickRange Range("A2")
    End If
End Sub

Private Sub ClickRange(ByVal Rng As Range)
    Const MOUSEEVENTF_LEFTDOWN = &H2, MOUSEEVENTF_LEFTUP = &H4
    Dim tRect As RECT
    Dim x As Long, y As Long

    tRect = GetRangeRect(Rng)
    With tRect
        x = .Left / 2& + .Right / 2&
        y = .Top / 2& + .Bottom / 2&
    End With
    Call SetCursorPos(x, y)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, x, y, 0&, ByVal NULL_PTR)
End Sub

Private Function GetRangeRect(ByVal obj As Object) As RECT
    Dim oPane  As Pane
    Set oPane = ThisWorkbook.Windows(1&).ActivePane

    With GetRangeRect
        .Left = oPane.PointsToScreenPixelsX(obj.Left - 1&)
        .Top = oPane.PointsToScreenPixelsY(obj.Top)
        .Right = oPane.PointsToScreenPixelsX(obj.Left + obj.Width)
        .Bottom = oPane.PointsToScreenPixelsY(obj.Top + obj.Height)
    End With
End Function

Code Edited: The PTtoPX routine was not needed.