How to create an AutoComplete Drop-Down

There may be times when you want to use a drop-down list box to make your selection but do not want to scroll down a long list to find the item you want.
This example shows you how your drop-down list can be automatically filtered to only show items that begin with a particular letter.

Code Module - Sheet 1

Private Sub cmbAutoCompleteOn_Click() 
   Call KeyEventOn 
End Sub 

Private Sub cmbAutoCompleteOff_Click() 
   Call KeyEventOff 
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim sText As String 
Dim sList As String 
Dim objCell As Range 
            
   If TypeName(Selection) <> "Range" Then Exit Sub 
   If Target.Cells.Count > 1 Then Exit Sub 
   
   If Application.Intersect(Target, Range(gsDropDownDisplayRange)) Is Nothing Then 
      Target.Validation.Delete 
      Exit Sub 
   End If 

   sText = Target.Value 
   With Selection.Validation 
      If Len(sText) = 0 Then 
         .Delete 
         .Add Type:=xlValidateList, _ 
                 AlertStyle:=xlValidAlertStop, _ 
                 Operator:=xlBetween, _ 
                 Formula1:="=" & gsNamedRange 
      Else 
         For Each objCell In Range(gsNamedRange) 
             If InStr(1, objCell.Value, sText, vbTextCompare) = 1 Then 
                 sList = sList & objCell.Value & Chr(&H2C) 
             End If 
         Next 
         
         Selection.Value = sText 
         .Delete 
         If Len(sList) = 0 Then 
            .Add Type:=xlValidateList, _ 
                 AlertStyle:=xlValidAlertStop, _ 
                 Operator:=xlBetween, _ 
                 Formula1:="=" & gsNamedRange 
         Else 
            .Add Type:=xlValidateList, _ 
                 AlertStyle:=xlValidAlertStop, _ 
                 Operator:=xlBetween, _ 
                 Formula1:="A,B,C" 
            .Delete 
            .Add Type:=xlValidateList, _ 
                 AlertStyle:=xlValidAlertStop, _ 
                 Operator:=xlBetween, _ 
                 Formula1:="=" & gsNamedRangeReduced 
         End If 
      End If 
   End With 
      
End Sub 

Standard Code Module

Public Const gsWorksheetName As String = "Sheet1" 
Public Const gsDropDownDisplayRange As String = "B3:B10" 
Public Const gsTemporaryListFirstCell As String = "E3" 
Public Const gsNamedRange As String = "Countries" 
Public Const gsNamedRangeReduced As String = "ReducedCountries" 

Public Sub KeyEventOn() 
Dim icount As Integer 
    For icount = 65 To 90 
        Application.OnKey "{" & icount & "}", "'MyValidation """ & icount & """'" 
    Next 
End Sub 

Public Sub KeyEventOff() 
Dim icount As Integer 
    For icount = 64 To 90 
        Application.OnKey "{" & icount & "}" 
    Next 
End Sub 

Public Sub MyValidation(ByVal KeyCode As Long) 
Dim sText As String 
Dim sList As String 
    
    If TypeName(Selection) <> "Range" Then Exit Sub 

    sText = Selection.Value & Chr(KeyCode) 
    sList = CreateReducedNamedRange(sText) 
        
    Selection.Value = sText 
    With Selection.Validation 
       .Delete 
       If Len(sList) > 0 Then 
         .Add Type:=xlValidateList, _ 
              AlertStyle:=xlValidAlertStop, _ 
              Operator:=xlBetween, _ 
              Formula1:="A,B,C" 
         .Delete 
         .Add Type:=xlValidateList, _ 
              AlertStyle:=xlValidAlertStop, _ 
              Operator:=xlBetween, _ 
              Formula1:="=" & gsNamedRangeReduced 
       End If 
    End With 
End Sub 

Public Function CreateReducedNamedRange(ByVal sChar As String) As String 
Dim objCell As Range 
Dim irowcount As Integer 
    
   irowcount = 0 
   With Worksheets(gsWorksheetName) 
      .Range(Range(gsTemporaryListFirstCell), _ 
             Range(gsTemporaryListFirstCell).Offset(200, 0)).Clear 
                                        
      For Each objCell In Range(gsNamedRange) 
         If Left(objCell.Value, 1) = sChar Then 
            .Range(gsTemporaryListFirstCell).Offset(irowcount, 0).Value = objCell.Value 
            
            CreateReducedNamedRange = CreateReducedNamedRange & objCell.Value 
            irowcount = irowcount + 1 
         End If 
      Next objCell 
      .Range(Range(gsTemporaryListFirstCell), _ 
             Range(gsTemporaryListFirstCell).Offset(irowcount - 1, 0)).Name = gsNamedRangeReduced 
   End With 
End Function 

2 from Sorted Table ???