Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i, i1 As Long
If KeyCode = 13 Then
  If ComboBox1.Text <> "" Then
    ActiveCell = ComboBox1.Text
    If ComboBox1.Text <> "" Then
        factor = 1
        For i = 1 To UBound(arr2)
            If ComboBox1.Text = arr2(i, 1) Then
                factor = 0
                Exit For
            End If
        Next
        If factor Then
            If MsgBox("Вы хотите внести новый подшипник в Таблицу минимальных цен?", vbYesNo, "Выбор") = vbYes Then
                newBearingCard.Show
                Else
                ComboBox1.Text = ""
                bearingName.Hide
                ActiveCell = ComboBox1.Text
                Exit Sub
            End If
        End If
    End If
    For i = 1 To UBound(arr2)
        If arr2(i, 1) = ComboBox1.Text Then
            Cells(ActiveCell.Row, 10) = arr2(i, 3)
            Cells(ActiveCell.Row, 11) = arr2(i, 4)
            Cells(ActiveCell.Row, 12) = arr2(i, 5)
            Cells(ActiveCell.Row, 13) = arr2(i, 7)
            Cells(ActiveCell.Row, 14) = arr2(i, 9)
            Cells(ActiveCell.Row, 15) = arr2(i, 2)
            Cells(ActiveCell.Row, 16) = arr2(i, 6)

            Exit For
        End If
    Next
  End If
  ComboBox1.Text = ""
bearingName.Hide
End If
If KeyCode = 27 Then
ComboBox1.Text = ""
bearingName.Hide
End If
End Sub

Private Sub UserForm_Initialize()
Dim s&
ComboBox1.MatchEntry = fmMatchEntryNone
   ComboBox1.List = arr3
   ComboBox1.Text = ""
End Sub

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim n&, b&
Dim Txt$
Dim Spisok(), NewSpisok()
If KeyCode <> 38 And KeyCode <> 40 And KeyCode <> 13 Then
    ComboBox1.List = arr2
    
    b = 0
    Txt = UCase("*" & ComboBox1.Text & "*")
    If Txt = "" Then ComboBox1.List = arr2: Exit Sub
    
    ComboBox1.Clear
    Erase NewSpisok
    
    For i = 1 To UBound(arr2)
        If IsNumeric(arr2(i, 2)) Then
        If UCase(arr2(i, 1)) Like Txt Then
            b = b + 1
            ReDim Preserve NewSpisok(b)
            NewSpisok(b) = arr2(i, 1)
        End If
        End If
    Next

    If b <> 0 Then ComboBox1.List = NewSpisok
End If
End Sub

Private Sub ComboBox1_Change()
ComboBox1.DropDown
End Sub