Excel Forum

Code: Select all

Private Comb_Arrow As Boolean
Private Sub ComboBox1_Change()
Dim i As Long
        If Not Comb_Arrow Then
        With Me.ComboBox1
            .List = Worksheets("Name List").Range("A2", Worksheets("Name List").Cells(Rows.Count, "A").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(4, .ListCount)
            .DropDown
               If Len(.Text) Then
                    For i = .ListCount - 1 To 0 Step -1
                       If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                         Next
                          .DropDown
                           End If
         End With
         End If
 End Sub
 Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Comb_Arrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    If KeyCode = vbKeyReturn Then Me.ComboBox1.List = Worksheets("Name List").Range _
    ("A2", Worksheets("Name List").Cells(Rows.Count, "A").End(xlUp)).Value
End Sub

Code: Select all

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
    Dim c As Integer
    If Target.Count > 1 Then Exit Sub
    If Target.Address(0, 0) = "B4" Then
        Call ListDropdown(Target)
    Else
        Me.OLEObjects("ComboBox1").Visible = False
    End If
End Sub

Code: Select all

Public Sub ListDropdown(ByVal Target)
    Dim xStr As String
    Dim xCombox As OLEObject
    Application.EnableEvents = False
    Set xCombox = Worksheets("Sheet5").OLEObjects("ComboBox1")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
        .Top = Target.Top
    End With
    
    With Worksheets("Name List")
        xStr = .Name & "!" & .Range("A2", .Range("A" & .Rows.Count).End(xlUp)) _
                    .Address(0, 0)
    End With
    
    With xCombox
        .Visible = True
        .Left = Target.Left
        .Top = Target.Top - 5
        .Width = Target.Width ' + 5
        .Height = Target.Height + 5
        .ListFillRange = xStr
        .LinkedCell = Target.Address
        .Activate
    End With
    Application.EnableEvents = True
End Sub

Code: Select all

Private Comb_Arrow As Boolean
Private Sub ComboBox1_Change()
Dim i As Long
        If Not Comb_Arrow Then
        With Me.ComboBox1
            .List = Worksheets("Name List").Range("A2", Worksheets("Name List").Cells(Rows.Count, "A").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(4, .ListCount)
            .DropDown
               If Len(.Text) Then
                    For i = .ListCount - 1 To 0 Step -1
                       If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                         Next
                          .DropDown
                           End If
         End With
         End If
 End Sub
 Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Comb_Arrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    If KeyCode = vbKeyReturn Then Me.ComboBox1.List = Worksheets("Name List").Range _
    ("A2", Worksheets("Name List").Cells(Rows.Count, "A").End(xlUp)).Value
End Sub
Private Sub CommandButton1_Click()
emptyRow = WorksheetFunction.CountA(Range("B:B")) + 1
Cells(emptyRow, 1).Value = ComboBox1.Value
Cells(emptyRow, 2).Value = TextBox2.Value
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub userform_initialize()
ComboBox1.Value = ""
TextBox2.Value = ""
End Sub

Code: Select all

Private Sub userform_initialize()
    ComboBox1.Value = ""
    TextBox2.Value = ""
    ComboBox1.SetFocus
End Sub

Private Sub CommandButton1_Click()
    emptyRow = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(emptyRow, 1).Value = ComboBox1.Value
    Cells(emptyRow, 2).Value = TextBox2.Value
    ComboBox1.Value = ""
    TextBox2.Value = ""
    ComboBox1.SetFocus
End Sub

Private Sub ComboBox1_Change()
    Dim i As Long
    If Not Comb_Arrow Then
        With Me.ComboBox1
            .List = Worksheets("Name List").Range("A2", Worksheets("Name List").Cells(Rows.Count, "A").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(4, .ListCount)
            If Len(.Text) Then
                .DropDown
            End If
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                   If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next
                .DropDown
            End If
         End With
    End If
 End Sub