Drop-down menu’s are useful, but what if you want to return a value based on the list, and not just the item in the list itself?

custom

To get this functionality we have to built our own custom menu. A solution is to add a temporary ListBox next to the selected cell. The ListBox gets triggered with the Worksheet_SelectionChange method. In this example a list of names will return the  abbreviation of the selected name, so the task-schedule is easy to set up. We also want the Esc-key to cancel out the menu, because that’s sort of expected by the Esc-key to do.

The table above is in worksheet “week”  and this is in it’s code-page:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("week")

On Error Resume Next
ws.ListBoxes("dropDown").Delete 'If the user change cell when the menu is open
On Error GoTo 0

Dim area, inArea As Range
Set area = ws.Range("C4:I10")  'table area

Set inArea = Application.Intersect(Target, area) 'Menu should only work inside the table

If Not inArea Is Nothing Then
    ws.ListBoxes.Add(Target.Left + 40, Target.Top, 100, 100).Select
    Selection.Name = "dropDown"
    With ws.ListBoxes("dropDown")
        .ListFillRange = "K3:K12"
        .LinkedCell = "K13"
        .MultiSelect = xlNone
        .Display3DShading = True
    End With
    Application.OnKey "{ESC}", "cancelMenu"
    ws.Shapes("dropDown").OnAction = "Module1.runList"
End If

Target.Select

End Sub

And add these two in Module1:

Sub runList()
    
    Dim i As Integer
    i = ThisWorkbook.Sheets("week").Range("K13").Value
    Selection = Cells(2 + i, 12).Value
    ThisWorkbook.Sheets("week").ListBoxes("dropDown").Delete

End Sub

Sub cancelMenu()
    On Error Resume Next
    ThisWorkbook.Sheets("week").ListBoxes("dropDown").Delete
    On Error GoTo 0
    Application.OnKey "{ESC}"  'resets ESC
End Sub

Explanation:

The listbox has 2 coordinates and 2 size values.

ws.ListBoxes.Add(Target.Left + 40, Target.Top, 100, 100).Select

Set name of the ListBox.

Selection.Name = "dropDown"

Makes the Esc-button trigger a Sub.

Application.OnKey "{ESC}", "cancelMenu"

Leaving out the last part will reset the button:

Application.OnKey "{ESC}"

When the user select a name in the list, trigger a method:

ws.Shapes("dropDown").OnAction = "Module1.runList"

When a list item is selected it updates the ListBox’s “Linked Cell”-cell (K13) and triggers the runList() sub.

flag

Advertisements