Selected Answer
The code in the attached workbook is divided into two modules. The first part, here following, must go into a standard code module. That is a module that doesn't exist. You have to create it. The default name will be "Module1". I renamed it as "TeachExcel". The name is without significance for the functionality. Actually, while your own workbook and the attached are both open, you can drag the module from my VBA Project into yours in the VBE's Project Explorer window. Dragging won't move the module but create a copy.
Option Explicit
Enum Nws ' worksheet navigation
' Variatus @TeachExcel 12 Apr 2020
' You can modify any of the enumerations below
' to match the facts on your worksheet
NwsFirstDataRow = 2 ' the program ignores rows above this row
' Columns: (1 = A, 2 = B etc)
NwsName = 1 ' Source for the drop-down list
End Enum
Function ActionRange(Ws As Worksheet) As Range
' Variatus @TeachExcel 12 Apr 2020
With Ws
Set ActionRange = .Range(.Cells(NwsFirstDataRow, NwsName), _
.Cells(.Rows.Count, NwsName).End(xlUp))
End With
End Function
Function CbxList(Ws As Worksheet) As Variant
' Variatus @TeachExcel 12 Apr 2020
' DdList is a worksheet created, used and deleted by this program
Const DdList As String = "DdList"
Dim WsL As Worksheet ' temporary List
Dim ListRng As Range
Dim Tmp As Variant
On Error Resume Next
Set WsL = Worksheets(DdList)
If Err Then
Set WsL = Worksheets.Add
WsL.Name = DdList
End If
On Error GoTo 0
' The last row in the range is the last used cell in the column.
ActionRange(Ws).Copy Destination:=WsL.Cells(1, 1)
With WsL
Set ListRng = .Cells(1, 1).Resize(ActionRange(Ws).Rows.Count)
With .Sort.SortFields
.Clear
.Add Key:=Cells(1, 1), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
End With
With .Sort
.SetRange ListRng
.Header = xlNo
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' exclude any blanks that might be included
CbxList = .Range(.Cells(1, 1), .Cells(.Rows.Count, NwsName).End(xlUp)).Value
End With
With Application
.EnableEvents = False
.DisplayAlerts = False
WsL.Delete
.DisplayAlerts = True
.EnableEvents = True
End With
End Function
The second instalment of the code goes to the worksheet's code module on which you want the action. In the attached workbook that is the sheet I named "Accounts". In VBE's Project Explorer it's identified as Sheet1 (Accounts). This code can't be dragged. You must copy and paste. But before you do so, please review the two values enumerated in the above code, NwsFirstDataRow and NwsName. They should be set correctly at this time. And, incidentally, that is all the adjustment you will have to make.
Option Explicit
Dim Cbx As OLEObject
Private Sub Worksheet_Activate()
' Variatus @TeachExcel 12 Apr 2020
' the drop-down list will be refreshed
' whenever this sheet is activated.
Const CbxName As String = "Dynamic_Cbx"
Dim Cell As Range
Application.ScreenUpdating = False
' delete existing Cbx
For Each Cbx In ActiveSheet.OLEObjects
Cbx.Name = CbxName
If Cbx.Name = CbxName Then
Cbx.Delete
Exit For
End If
Next Cbx
Set Cell = Cells(NwsFirstDataRow, NwsName)
With Cell
Set Cbx = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.ComboBox.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=.Left, Top:=.Top - 1, _
Width:=.Offset(0, 1).Left - .Left + 15, _
Height:=Round(Cell.Font.Size * 1.8, 0))
End With
With Cbx
.Name = CbxName
.LinkedCell = ""
.Visible = False
With .Object
.List = CbxList(ActiveSheet)
.MatchEntry = fmMatchEntryFirstLetter
.TextAlign = 1 ' align left
.SelectionMargin = False
With .Font
.Name = Cell.Font.Name
.Size = Cell.Font.Size
.Bold = False
End With
End With
End With
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Variatus @TeachExcel 12 Apr 2020
Dim Rng As Range
Set Rng = ActionRange(ActiveSheet)
If Cbx Is Nothing Then Worksheet_Activate
With Cbx
If Application.Intersect(Target, Rng.Resize(Rng.Rows.Count + 1)) Is Nothing Or _
(Target.Cells.CountLarge > 1) Then
.Visible = False
.LinkedCell = ""
Else
.Top = Target.Top - 1
.Visible = True
.LinkedCell = Target.Address
End If
End With
End Sub
Now the code is fully enabled, and this is how it works:-
When you activate the Accounts sheet a combobox is created invisibly and loaded with the list taken from the column identified as NwsName. The implication of this method is that changes made to the account names will not be reflected in the drop-down list until you click on another sheet and come back. That triggers an automatic update.
Now, when you click on any cell in the NwsName column the combobox will be moved to the clicked cell, assume its value, and become visible. The blank cell immediately below the end of the column will also respond in this way but not the cells further down. If you enter a first character which is available in the list the first matching value will be displayed. You can use the up and down arrows to go to the next or previous name or you can open the drop-down with the already selected name pre-selected and continue your selection from there.
Once you click on another cell the combobox will go somewhere else and leave the selected value behind in the cell it was covering before. If the next cell is within the NwsName column the combobox will assume that cell's value and you can modify it. If you click elsewhere on the sheet the combobox will become invisible.
I didn't think of adding new names until this moment. The combobox can be set to allow that and perhaps it is. If it isn't the current workaround is to enter the new name in the second row under the end of the NwsName column, activate another sheet, come back and find the name included in the drop-down. The Combobox has many properties. My code sets only a few of them. Others may take the defaults you set for other comboboxes in other projects on the same PC. So, don't be surprised if your combobox suddenly decides to behave differently. You can easily modify my code to set any property you can identify as relevant.
If you close and save the workbook with a cell in the NwsName column selected. The combobox will not be functioning when you reload the workbook until you click on another cell or activate another tab. This flaw is curable with a little extra coding. There may be other such flaws which I didn't think of yet but which will appear when you start using the feature.
The drop-down list is prepared by copying the NwsColumn to another sheet which is especially inserted for this purpose and later deleted. There the list is sorted. Duplicates aren't removed but could be. Blanks are removed. If the list is very long, like a couple of hundred items, there will be a delay while this is going on. In normal use the list will be prepared only when the sheet is loaded, or perhaps on first use in the morning. So the delay shouldn't be an issue. If it becomes bothersome, however, there are ways of speeding up the process, for instance, by keeping the extra sheet with a sorted list in it permanently.
