Code.bas

Attribute VB_Name = "Code"
'+----------------------------------------------------------------------------------------------------------------+
'| Code adapted by:                                                                                               |
'|     Ferdinand Feoli                                                                                            |
'|                                                                                                                |
'| Adapted from:                                                                                                  |
'|     https://stackoverflow.com/questions/54063168/lose-focus-from-combobox-with-control-arrowkeys-excel/        |
'|                                                                                                                |
'| My profile:                                                                                                    |
'|     www.linkedin.com/in/ferdinandfeoli                                                                         |
'|                                                                                                                |
'| Description:                                                                                                   |
'|     Just a VBA coding test.                                                                                    |
'|                                                                                                                |
'|     Places a combobox in selected cell (in this case range of action are yellow cells only),                   |
'|     you can move through cells/comboboxes using CTRL+{ARROW} keys.                                             |
'|                                                                                                                |
'|     Use this code as you want.                                                                                 |
'|                                                                                                                |
'+----------------------------------------------------------------------------------------------------------------+


'declare virtual key event listener ---------------------------------------
#If VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
#End If
'--------------------------------------------------------------------------


'declare virtual key constants -------------------------------------------
Private SWITCH As Boolean
    'The variable SWITCH is an auxiliar wich helps to break iterations.

Private Const VK_CTRL = &H11 'CONTROL key
Private Const VK_LEFT = &H25 'LEFT ARROW key
Private Const VK_UP = &H26 'UP ARROW key
Private Const VK_RIGHT = &H27 'RIGHT ARROW key
Private Const VK_DOWN = &H28 'DOWN ARROW key
'--------------------------------------------------------------------------

'For more information about virtual key interactions with VBA visit the following link:
'    https://wellsr.com/vba/2017/excel/GetAsyncKeyState-vba-to-wait-until-a-key-is-pressed/


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'Variable declaration ---------
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr
    '------------------------------

    'Set objects -----------------------------
    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")
    '-----------------------------------------
    
    ' Set combobox properties ----------------
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    '-----------------------------------------
    
    If Target.Validation.Type = 3 Then
        ' If the cell conians data validation list,
        'place the combobox object on it, an load
        'in there the items.
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = RIGHT(xStr, Len(xStr) - 1)
        
        If xStr = "" Then Exit Sub
        
        With xCombox
        
            .Visible = True
            
            If Not SWITCH Then
                .LEFT = Target.LEFT
                .Top = Target.Top
            End If
            
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            
            If .ListFillRange = "" Then
                xArr = Split(xStr, ",")
                Me.TempCombo.List = xArr
            End If
            
            .LinkedCell = Target.Address
            
        End With
        
        xCombox.Activate
        
    End If

End Sub


Private Sub TempCombo_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    ' When a key is pressed while a combobox is active, read the key pressed by the user,
    ' If it's the CTRL key, proceed to read the second key pressed (ARROW).
    ' Execute a different command depending of wich key is pressed.

    If Not SWITCH Then
    
        Do While GetAsyncKeyState(VK_CTRL) <> 0
        
            If GetAsyncKeyState(VK_LEFT) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(1, 0).Address).Activate
                Exit Do
    
            ElseIf GetAsyncKeyState(VK_RIGHT) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(1, 2).Address).Activate
                Exit Do
    
            ElseIf GetAsyncKeyState(VK_UP) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(0, 1).Address).Activate
                Exit Do
    
            ElseIf GetAsyncKeyState(VK_DOWN) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(2, 1).Address).Activate
                Exit Do
    
            End If
    
        Loop
    
    Else
    
        SWITCH = False
        
    End If
    
    If keycode = 17 Then SWITCH = True
    
End Sub