#1
  1. No Profile Picture
    Registered User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Oct 2012
    Posts
    1
    Rep Power
    0

    Help with combobox


    I have an excel 2003 workbook that contains and alphabetized list of names in the format Last, First.
    I have a combobox in a form that reads the contents of the list of names so i can choose one from the list, no problem with that.
    If the name is not on the list (after typing several letters of the first name it goes beyond the alphabetical order so the name is not there) i would like to enter the new name into the combobox, then add it to the list and finaly save the complete list back to the sheet.
    My question is: if I type something that is not in the list the program gives me an error. How can i actually solve that?
    Here is the code I'm using to choose from the list:

    Private Sub UserForm_initialize()
    Dim i As Integer
    Dim final As String

    Sheets("Notes").Select
    i = 1
    final = "start"
    Do While final <> "FIN"
    final = Cells(i + 4, 3)
    cb_institution.AddItem final, (i - 1)
    i = i + 1
    Loop
    cb_institution.RemoveItem (i - 2)
    End Sub

    Thanks!
  2. #2
  3. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Aug 2011
    Posts
    289
    Rep Power
    45
    What you need to do is to always have a non existent or fictional name as the first name in the list such as " NO MATCH" (notice the first space) in an alphabetically sorted list. Then if that item is ever selected, you know that the user either made a typing error, or needed to enter a new name, and you react accordingly.

    Even at that, there are still a few problems with the combo box that I could not get around. I found that I had more control if I used 3 separate controls:
    - list box
    - text box
    - image box created to look like drop down arrow

    The sample code below is probably more complex than what you need, but it will give you the idea.

    J.A. Coutts
    Code:
    Private Sub CustDrop_Click()
        CustList.Visible = Not CustList.Visible
    End Sub
    
    Private Sub CustList_Click()
        Dim vKeys, vExceptions As Variant
        Dim Result As Long
        Dim sErr As String
        Const sProc As String = "CustList Click"
        On Error GoTo CustError
        If CustList.ListIndex > -1 Then
            CustText = CustList.List(CustList.ListIndex)
        Else
            Call SendMessage(CustList.hWnd, LB_SETTOPINDEX, 0, "")
        End If
        If CursorKeyFlg Then
            CursorKeyFlg = False
        Else
            CustList.Visible = False
        End If
        If CustList.ListIndex < 0 Then Exit Sub
        CustNo$ = CustListData(1, CustList.ListIndex)
        vKeys = "SELECT * From Customer WHERE Customer.CustNo = '" + CustNo$ + "';"
        Result = GetLocalData(vKeys, CustData, vExceptions)
        Label8 = CustNo$
        If Not Result Then
            MsgBox "No number found for " + CustList
            Exit Sub
        End If
        CustText.Text = CustData(1, 0) 'CustName
        BillName.Locked = False
        BillName.Text = CustText
        BillName.Locked = True
        BillAddress1 = IIf(IsNull(CustData(2, 0)), "", CustData(2, 0)) 'Addr line 1
        BillAddress2 = IIf(IsNull(CustData(3, 0)), "", CustData(3, 0)) 'Addr line 2
        BillAddress3 = IIf(IsNull(CustData(4, 0)), "", CustData(4, 0)) 'Addr line 3
        BillZip = IIf(IsNull(CustData(5, 0)), "", CustData(5, 0)) 'Postal code
        BillPhone = IIf(IsNull(CustData(6, 0)), "", CustData(6, 0))   'Phone
        CustCode = IIf(IsNull(CustData(7, 0)), "", CustData(7, 0))    'Code
        CustChngFlg = False
        Exit Sub
    CustError:
        sErr = msModule & gsDelimiter & sProc _
            & gsDelimiter & Err.Number & gsDelimiter & Err.Description
        Call LogError(sErr)
        Call FatalError(sErr)
        End
    End Sub
    
    Private Sub CustList_DblClick()
        Dim N%
        Dim Result As Long
        Dim vKeys, vExceptions As Variant
        If CustList.ListCount > 0 Then Exit Sub
        Screen.MousePointer = 11
        CustList.Clear
        vKeys = "SELECT CustName, CustNo From Customer ORDER BY CustName;"
        Result = GetLocalData(vKeys, CustListData, vExceptions)
        For N% = 0 To UBound(CustListData, 2)
            CustList.AddItem CustListData(0, N%)
        Next N%
        Screen.MousePointer = 0
    End Sub
    
    Private Sub CustList_KeyDown(KeyCode As Integer, Shift As Integer)
        Select Case KeyCode
            Case Key_Down, Key_Up, Key_Right, Key_Left
                CursorKeyFlg = True
        End Select
    End Sub
    
    
    Private Sub CustList_KeyPress(KeyAscii As Integer)
        If KeyAscii = 13 Then
            CustList.Visible = False
            CustDrop.Visible = True
            KeyAscii = 0
            Call CustText_KeyPress(13)
        End If
    End Sub
    
    
    Private Sub CustList_LostFocus()
        If ActiveControl.Tag <> "DrpDwn" Then
            If CustList.ListIndex > 0 Then
                CustText.Visible = False
                CustList.Visible = False
                CustDrop.Visible = False
            End If
        End If
    End Sub
    
    Private Sub CustText_Change()
        Dim Result As Long
            Result = SendMessage(CustList.hWnd, LB_SELECTSTRING, -1, CustText.Text)
        If Result > -1 Then
            'Debug.Print "Item " + Str$(Result) + " Selected!"
        Else
            CursorKeyFlg = True
            CustList.ListIndex = -1
        End If
    End Sub
    
    Private Sub CustText_Click()
        CustList.Visible = True
        CustDrop.Visible = True
    End Sub
    
    Private Sub CustText_GotFocus()
        CustText.SelStart = 0
        CustText.SelLength = Len(CustText)
    End Sub
    
    
    Private Sub CustText_KeyDown(KeyCode As Integer, Shift As Integer)
        Select Case KeyCode
            Case Key_Down
                CustList.Visible = True
                CustList.SetFocus
                KeyCode = 0
        End Select
    End Sub
    
    Private Sub CustText_KeyPress(KeyAscii As Integer)
        Dim Response%
        Dim Result
        Dim vKeys, vExceptions As Variant
        KeyAscii = Asc(UCase(Chr(KeyAscii)))
        'CursorKeyFlg = False
        If KeyAscii = 13 Then
            KeyAscii = 0
            If Left$(CustText, 2) = "  " Then
                MsgBox "'" + CustText + "' is not a valid selection!", 48
                Exit Sub
            ElseIf CustList.ListIndex < 1 Then
                vKeys = "SELECT * From Customer WHERE Customer.CustName = '" + CustText.Text + "';"
                Result = GetLocalData(vKeys, CustData, vExceptions)
                If Not Result Then
                    Response% = MsgBox("No Selection Made!" + vbCrLf + "Use Name Entered?", 292, "CUSTOMER NAME")
                    If Response% = 7 Then   'Response = no
                        CustText = ""
                        CustText.Visible = True
                        Exit Sub
                    Else    'User wants to enter new customer
                        'grab last customer to ensure array has data
                        vKeys = "SELECT CustNo From Customer ORDER BY Customer.CustNo"
                        Result = GetLocalData(vKeys, CustData, vExceptions)
                        CustNo$ = CustData(0, UBound(CustData, 2))
                        vKeys = "SELECT * From Customer WHERE Customer.CustNo = '" + CustNo$ + "';"
                        Result = GetLocalData(vKeys, CustData, vExceptions)
                    End If
                Else
                    MsgBox "Customer already exists!" + vbCrLf + "Please select from list!"
                    Exit Sub
                End If
            Else
                Call CustList_Click
            End If
            CustList.Visible = False
            BillName.Locked = False
            BillName.Text = CustText
            BillName.Locked = True
            If CustList.ListIndex < 1 Then
                BillAddress1.SetFocus
            ElseIf ManInvFlg Then
                PsngrGrd.Row = 1
                FPayment.SetFocus
            Else
                Heading.SetFocus
            End If
        End If
    End Sub
    
    
    Private Sub CustText_LostFocus()
        If ActiveControl.Tag <> "DrpDwn" Then
            If CustList.ListIndex > 0 Then
                CustText.Visible = False
                CustList.Visible = False
                CustDrop.Visible = False
            End If
        End If
    End Sub

IMN logo majestic logo threadwatch logo seochat tools logo