Private Sub YID_Change()
ComChange Me.YID, "[Официальное_имя]"
End Sub

Private Sub YID_AfterUpdate()
ComUpdate Me.YID
End Sub

Public Function ComChange(con As ComboBox, FieldName As String)
Dim rec As ADODB.Recordset
If con.SelText = "" Then
    Set rec = con.Recordset.Clone
    If con.Text <> "" Then rec.Filter = FieldName & " Like '*" & con.Text & "*'"
    Set con.Recordset = rec
    
    con.Dropdown
    con.SelStart = Len(con.Text) +  1 
End If
End Function

Public Function ComUpdate(con As ComboBox)
Dim rec As ADODB.Recordset
Set rec = con.Recordset.Clone
Set con.Recordset = rec
End Function

Public Function ComChange(con As ComboBox, FieldName As String)
If con.SelText = "" Then
    If con.Text <> "" Then con.Recordset.Filter = FieldName & " Like '*" & con.Text & "*'"
    Set con.Recordset = con.Recordset.OpenRecordset
    con.Dropdown
    con.SelStart = Len(con.Text) +  1 
End If
End Function

Public Function ComUpdate(con As ComboBox)
Set con.Recordset = Nothing
End Function

'Модуль
Option Compare Database
Option Explicit

Private ComboRec As Recordset

Public Function ComChange()
On Error GoTo er
    With Screen.ActiveControl
        If .SelText = "" Then
            If ComboRec Is Nothing Then Set ComboRec = .Recordset.Clone
            If .text <> "" Then ComboRec.Filter = ComboRec.Fields(1).Name & " Like '*" & Replace(.text, " ", "*") & "*'"
            Set .Recordset = ComboRec.OpenRecordset
            .Dropdown
            .SelStart = Len(.text) + 1
        End If
    End With
ex: Exit Function
er: Debug.Print "ComChange Error", Err.description
End Function

Public Function ComUpdate()
On Error Resume Next
    Set Screen.ActiveControl.Recordset = Nothing
    Set ComboRec = Nothing
End Function

'Модуль
Option Compare Database
Option Explicit

Private ComboRec As Recordset

Public Function ComChange()
On Error GoTo er
    With Screen.ActiveControl
        If .SelText = "" Then
            If ComboRec Is Nothing Then Set ComboRec = .Recordset.Clone
            ComboRec.Filter = ComboRec.Fields(1).Name & " Like '*" & Replace(.text, " ", "*") & "*'"
            Set .Recordset = ComboRec.OpenRecordset
            .Dropdown
            .SelStart = Len(.text) + 1
        End If
    End With
ex: Exit Function
er: Debug.Print "ComChange Error", Err.description
End Function

Public Function ComUpdate()
On Error Resume Next
    Set Screen.ActiveControl.Recordset = ComboRec
    Set ComboRec = Nothing
End Function