Sub AddItemShortCutMenu()
Dim Shortcut As CommandBar
Dim NewItem As CommandBarButton

Set Shortcut = ThisWorkbook.Application.CommandBars("Cell")
Set NewItem = Shortcut.Controls.Add(Type:=msoControlButton)
With NewItem
.Caption = "Custom Action"
.OnAction = "CustomSubroutine" 'The subroutine must be located in Module1 for some reason
End With
End Sub