Dim aList()
Sub MakeList(ByVal Sour As Range, ByRef Dest As Object)
    Dim c As Range, n As Integer, aList()
    For Each c In Sour.Cells
        If Len(c.Value) > 0 Then
            n = n + 1
            ReDim Preserve aList(1 To n)
            aList(n) = c.Value
        End If
    Next c
    Dest.List = aList
End Sub ' эта часть убирает пустые значения из комбобоксов

Private Sub UserForm_Activate()
MakeList Sheets("data").Range("j2:j20"), ComboBox1 ' диапазон столбца записывается в комбобок, так же комбобокс ищет по первым буквам.
End Sub

Private Sub TextBox_passport_Change()
    Dim НайденноеЗначение As Range
    If Len(TextBox_passport.Value) Then
        Set НайденноеЗначение = Sheets("2021").ListObjects("OrderList").DataBodyRange.Columns(13).Find(TextBox_passport.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not НайденноеЗначение Is Nothing Then
            MsgBox TextBox_passport.Value & " есть в строке " & НайденноеЗначение.Row
        End If
    End If
End Sub

Private Sub TextBox_name_Change()
Dim ws1 As Worksheet, tbl1 As ListObject, LookupValue As String, FoundCell As Range, answer

    If Trim(Me.TextBox_name.Value) = "" Then
        MsgBox "Пожалуйста, Введите Имя которого нет в Базе"
        Me.TextBox_name.SetFocus
        Exit Sub
    End If

    Set ws1 = Sheets("2021")
    Set tbl1 = ws1.ListObjects("OrderList")
    LookupValue = Me.TextBox_name.Value
    On Error Resume Next
    Set FoundCell = tbl1.DataBodyRange.Columns(2).Find(LookupValue, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0

    If Not FoundCell Is Nothing Then
        answer = MsgBox("Это Имя уже существует в данной Базе. " & " в СТРОКЕ НОМЕР " & FoundCell.Row & vbCrLf & "Вы Хотите Повторить данное Имя", vbQuestion + vbYesNo + vbDefaultButton2, " Дублировать ? ")
        Me.ComboBox_cartype.SetFocus

        If answer = vbNo Then
            '            ClearForm
            Me.TextBox_name.Value = ""
            Me.TextBox_name.SetFocus
            Exit Sub
        End If

    End If

End Sub

Private Sub TextBox_passport_Change()
Dim НайденноеЗначение As Range
If Len(TextBox_passport.Value) Then
Set НайденноеЗначение = Sheets("2021").ListObjects("OrderList").DataBodyRange.Columns(13).Find(TextBox_passport.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not НайденноеЗначение Is Nothing Then
'MsgBox TextBox_passport.Value & " есть в строке " & НайденноеЗначение.Row
Sheets("2021").Rows(НайденноеЗначение.Row).Select
End If
End If
End Sub

Private Sub TextBox_name_Change()
    Dim ws1 As Worksheet, tbl1 As ListObject, FoundCell As Range, answer As VbMsgBoxResult

    Set ws1 = Sheets("2021")
    Set tbl1 = ws1.ListObjects("OrderList")
    On Error Resume Next
    Set FoundCell = tbl1.DataBodyRange.Columns(2).Find(Me.TextBox_name.Value, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0

    If Not FoundCell Is Nothing Then
        Rows(FoundCell.Row).Select
    End If

End Sub