Select Combo Box Item by index (1 Viewer)

Mage-7 · May 7, 2010

This is not original problem. My original problem is that my combo box(Combo) is related to a table where are 3 fields of whose two are related to other two tables. Anyway I update two last and then I successfully update the first windows as well through VB code. Now keep in mind that I do everything in NOT IN LIST event. So after I update all that I require and try to inform combo box that new record is added with command Response = acDataErrAdded I get error that combo box can't fit value into the field. If I go to a combo box after error I can choose value I entered before just fine. And that I understand because I enter 3 different values(Job Title, Job Place, Salary) excluded by semicollon. And in combo box only the ID of record is saved from which it takes all the information.

So I though a workaround. I try to refresh my combobox after last record is added to database(checked combo box max index with command Combo.ListCount and the RowSource max index was increased by one).
The problem that killing me is that I can't find enough information how to set focus on combo box specific item if I know that item index. By the way Combo Rowsource is bound to 4th column.
I would appreciate any help because I'm sitting near this combobox +24 hours and the last thing that's left to fix is to select added record..

Not posting VB code because I don't think it's neccesarry in this situation. All I need is a simple example..

wiklendt · May 10, 2010

well, if you won't post VBA, i will. this is what a typical not in list code looks like in one of my databases. BUT, i suspect your problem is with your relationships with your tables. could you do a relationship window screenshot with the relevant tables for us, please (and i mean the two tables and any others that might be related to them), so we can, at least, exclude that from the possibilities?

Code:

Private Sub cmbCategoryID_NotInList(NewData As String, Response As Integer)
On Error GoTo Err_cmbCategoryID_NotInList

Dim intAnswer As Integer
Dim strSQL As String
Dim intCurrentUser As Integer

intCurrentUser = Forms!frmLogin.cmbUser

intAnswer = MsgBox("The Category " & Chr(34) & NewData & _
    Chr(34) & " is not currently listed." & vbCrLf & _
    "Would you like to add it to the list now?" _
    , vbQuestion + vbYesNo, fstrDBname)

If intAnswer = vbYes Then

    strSQL = "INSERT INTO tlkpCategories([Category], [UserCreated])" & _
             "VALUES ('" & NewData & "', '" & intCurrentUser & "');"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    MsgBox "New Category added.", vbInformation, fstrDBname
    Response = acDataErrAdded

Else
    MsgBox "Please choose a Category from the available list." _
            , vbInformation, fstrDBname
    Response = acDataErrContinue
End If

Exit_cmbCategoryID_NotInList:
    Exit Sub

Err_cmbCategoryID_NotInList:
    Msg = "Error # " & Str(Err.Number) & Chr(13) & Chr(13) & " (" & Err.Description & ")"
    Msg = Msg & Chr(13) & Chr(13) & "in Form_frmItems | cmbCategoryID_NotInList"
    MsgBox Msg, vbMsgBoxHelpButton, fstrDBname & ": Error", Err.HelpFile, Err.HelpContext
    Resume Exit_cmbCategoryID_NotInList

End Sub

Mage-7 · May 10, 2010

Here is my code. Since I'm doing all errors in my language, so Not in list error gives me quite a headache. Just don't mind all error message box text. I'm not posting functions because all the do is checking data integrity and modifies text(i.e. uppercase letters after each space in text line, change two or more spaces to one) As for others:
Eilute is text line which later is used with split command.
reiksme is array where I store all my data after split
dublis is Single. It is record duplication index. If i reach dublis to two. Then I recheck all records to check if identical record isn't already in a database because in one record can be two same records and the third one different(syntax:Job Title, Job Place, Salary. i.e.: Salesman, Shop, 1000. i.e.2: Salesman, Shop, 1500).
Also I added Tables.png file if you curious to see..

Code:

Private Sub darb_id_NotInList(NewData As String, Response As Integer)
    On Error GoTo KLAIDA
    Response = acDataErrContinue    'Panaikina standartine klaida
    Beep
    Dim eilute As String
    eilute = NewData
    eilute = NaikintiDuTarpus(eilute)
    If TarpaiGale(eilute) = True Or TarpaiPradzioje(eilute) = True Then
        If TarpaiGale(eilute) = True Then
            eilute = Left$(eilute, Len(eilute) - 1)
        End If
        If TarpaiPradzioje(eilute) = True Then
            eilute = NaikintiTarpusPradzioje(eilute)
        End If
        darb_id.Text = eilute
        Exit Sub
    End If
    Dim indeksas As Single
    For i = 1 To Len(eilute)
        If Mid$(eilute, i, 1) = "," Then
            indeksas = indeksas + 1
        End If
    Next
    If indeksas = 2 Then    'Maksimalus indeksas(indeksas 0,1,2)
        Dim reiksme() As String
        reiksme = Split(eilute, ",")
        reiksme(2) = NaikintiVisusTarpus(reiksme(2))
        reiksme(0) = NaikintiTarpusPradzioje(reiksme(0))
        reiksme(1) = NaikintiTarpusPradzioje(reiksme(1))
        reiksme(0) = NaikintiDuTarpus(reiksme(0))
        reiksme(1) = NaikintiDuTarpus(reiksme(1))
        Do While TarpaiGale(reiksme(0)) = True
            reiksme(0) = Left$(reiksme(0), Len(reiksme(0)) - 1)
        Loop
        Do While TarpaiGale(reiksme(1)) = True
            reiksme(1) = Left$(reiksme(1), Len(reiksme(1)) - 1)
        Loop
        If RaideTarpas(reiksme(0)) = False Or RaideTarpas(reiksme(1)) = False Or Skaicius(reiksme(2), 1) = False Then
            MsgBox "Blogai ivesti nauju darbuotojo pareigu duomenys! Duomenys turi susidaryti iš skaiciu, raidžiu ir tarpu. Skaicius galima rašyti tik algai, o raides tik pareigoms ir padaliniui." & vbCrLf & "Pavyzdys: Vyresnysis Sandelininkas, Viršuniškiu Sandelys, 3000", vbOKOnly, "KLAIDA!"
        Else
            reiksme(0) = DidziosiosPoTarpu(reiksme(0))
            reiksme(1) = DidziosiosPoTarpu(reiksme(1))
            Mid$(reiksme(0), 1, 1) = UCase$(Mid$(reiksme(0), 1, 1))
            Mid$(reiksme(1), 1, 1) = UCase$(Mid$(reiksme(1), 1, 1))
            Do While Mid$(reiksme(2), 1, 1) = "0" And Len(reiksme(2)) > 1
                For i = 1 To Len(reiksme(2)) - 1
                    Mid$(reiksme(2), i, 1) = Mid$(reiksme(2), i + 1, 1)
                Next
                reiksme(2) = Left$(reiksme(2), Len(reiksme(2)) - 1)
            Loop
            If reiksme(2) = "0" Then
                MsgBox "Draudžiama darbuotojui ivesti nuline alga!", vbOKOnly, "Demesio!"
                Exit Sub
            ElseIf Len(reiksme(0)) < 3 Then
                MsgBox "Darbuotojo pareigos turi susidaryti bent iš triju simboliu!", vbOKOnly, "Demesio!"
                Exit Sub
            ElseIf Len(reiksme(0)) > 50 Then
                MsgBox "Darbuotojo pareigos turi susidaryti ne iš daugiau, nei 50 simboliu!", vbOKOnly, "Demesio!"
                Exit Sub
            ElseIf Len(reiksme(1)) < 3 Then
                MsgBox "Padalinys, kuriame darbuotojas dirbs turi susidaryti bent iš 3 simboliu!", vbOKOnly, "Demesio!"
                Exit Sub
            ElseIf Len(reiksme(1)) > 50 Then
                MsgBox "Padalinys, kuriame darbuotojas dirbs turi susidaryti ne iš daugiau, nei 50 simboliu!", vbOKOnly, "Demesio!"
                Exit Sub
            End If
            If MsgBox("Norite prideti darbuotojo informacija, kuri susidaro iš:" & vbCrLf & "Darbuotojo pareigu: ''" & reiksme(0) & "''" & vbCrLf & "Darbovietes: ''" & reiksme(1) & "''" & vbCrLf & "Algos: " & reiksme(2), vbOKCancel, "Irašymo patvirtinimas") = vbOK Then
                Dim db As Database
                Set db = CurrentDb()
                Dim Lentele As Recordset
                Dim SQL As String
                SQL = "Select * FROM PAREIGOS"
                Set Lentele = db.OpenRecordset(SQL, dbOpenDynaset)
                Lentele.AddNew
                Lentele![pav] = reiksme(0)
                Lentele.Update
                Dim pareigos As Single
                Lentele.Bookmark = Lentele.LastModified
                pareigos = Lentele![ID]
                Dim dublis As Single
                If pareigos = 0 Then
                    dublis = 1
                    Lentele.MoveFirst
                    Do While Lentele![pav] <> reiksme(0)
                        Lentele.MoveNext
                    Loop
                    pareigos = Lentele![ID]
                End If
                Lentele.Close
                SQL = "Select * FROM PADALINIAI"
                Set Lentele = db.OpenRecordset(SQL, dbOpenDynaset)
                Lentele.AddNew
                Lentele![pav] = reiksme(1)
                Lentele.Update
                Dim padaliniai As Single
                Lentele.Bookmark = Lentele.LastModified
                padaliniai = Lentele![ID]
                If padaliniai = 0 Then
                    dublis = dublis + 1
                    Lentele.MoveFirst
                    Do While Lentele![pav] <> reiksme(1)
                        Lentele.MoveNext
                    Loop
                    padaliniai = Lentele![ID]
                End If
                Lentele.Close
                SQL = "SELECT * FROM [DARBUOTOJU INFORMACIJA]"
                Set Lentele = db.OpenRecordset(SQL, dbOpenDynaset)
                If dublis = 2 Then
                    Do While Not Lentele.EOF
                        If Lentele!alg = reiksme(2) And Lentele!pad_id = padaliniai And Lentele!par_id = pareigos Then
                            MsgBox "Identiškas irašas jau egzistuoja! Šis irašas nebus irašytas.", vbCritical, "Demesio!"
                            Me.Undo
                            Exit Sub
                        End If
                        Lentele.MoveNext
                    Loop
                End If
                Lentele.AddNew
                Lentele![alg] = reiksme(2)
                Lentele![par_id] = pareigos
                Lentele![pad_id] = padaliniai
                Lentele.Update
                Lentele.Bookmark = Lentele.LastModified
                Lentele.Close
                Beep
                MsgBox "Nauji duomenys išsaugoti.", vbInformation, "Pranešimas"
                darb_id.Text = reiksme(0)
                NewData = reiksme(0)
                Response = acDataErrAdded
            Else
                Me.Undo
            End If
        End If
    Else
        MsgBox "Irašytu darbuotojo pareigu saraše nera! Pasitikrinkite ar rašydami naujas pareigas nepridejote per daug kableliu. Jei norite irašyti naujas darbuotojo pareigas rašykite duomenis atskirdami kablelias." & vbCrLf & "Duomenu sintakse: Pareigu pavadinimas, Padalinio pavadinimas, Alga." & vbCrLf & "Pavyzdys: Vyresnysis Sandelininkas, Viršuniškiu Sandelys, 3000", vbOKOnly, "Demesio!"
    End If
    '------------------------------------------
KLAIDA:
    Select Case Err.Number
    Case 0
    Case 20
    Case 94    'Dirbama su nuline reiksme nors draudziama(veiksmas neivykdytas)
    Case 3016    'Irasas netilpo i lentele(nes lenteleje saugoma triju lauku irasai)
    Case 3021
    Case 3022    'I lentele nebuvo irasyti nauji duomenys, nes dubliavimas draudziamas o duomenys buvo dubliuoti
    Case 3709
    Case Else
        MsgBox "Klaidos kodas yra: " & Err.Number & " . Praneškite apie šia klaida programos kurejui ir ji bus ištaisyta.", vbExclamation + vbOKOnly, "Klaidos pranešimas"
    End Select
    Resume Next
    '------------------------------------------
End Sub

wiklendt · May 10, 2010

could you please re-post your code using the code wrap? i can't read it like that.

boblarson · May 10, 2010

wiklendt said:
could you please re-post your code using the code wrap? i can't read it like that.

I did a quick reformat using Smart Indenter (cool tool - don't leave home without it) and then added code tags.

wiklendt · May 10, 2010

is that czeski?

wiklendt · May 10, 2010

boblarson said:
I did a quick reformat using Smart Indenter (cool tool - don't leave home without it) and then added code tags.

that's a neat trick boB!

boblarson · May 10, 2010

wiklendt said:
that's a neat trick boB!

It's a cool tool AND is FREE.

wiklendt · May 10, 2010

OMG - ALL that code in a "not in list" event and Mage-7 thought it had nothing to do with the problem??? LOL it's going to take a little while to go through all that....

Mage-7 · May 13, 2010

Sorry I was off for so long. You're lucky I haven't posted all code from that one form. It's just one event

Anyway I found a solution. If anyone else will try to add few records through one comboBox, or select Combo Box Item By it's Index then this post might help:

So basicaly after you inserted ALL records in all tables you wanted you should replace line :

Response = acDataErrAdded

To:

ComboBox.Text = "" 'You set your Combobox text to nothing and you trigger ComboBox AfterUpdate() event.
DoCmd.CancelEvent 'And you cancel Not In List event

Now go to your ComboBox AfterUpdate() and type this:

Dim index As Single 'Current ComboBox items count
index = ComboBox.ListCount 'Save current Items count
ComboBox.Requery 'ComboBox Refresh
If ComboBox.ListCount <> index Then 'If ComboBox items increased after refresh
ComboBox.Value = ComboBox.ItemData(ComboBox.ListCount - 1) 'Set your comboBox selected item to last(If you Assend items not by ID then it might be a problem)
End If

Select Combo Box Item by index (1 Viewer)

Mage-7

New member

wiklendt

i recommend chocolate

Mage-7

New member

Attachments

wiklendt

i recommend chocolate

boblarson

Smeghead

wiklendt

i recommend chocolate

wiklendt

i recommend chocolate

boblarson

Smeghead

wiklendt

i recommend chocolate

Mage-7

New member

Similar threads

Users who are viewing this thread