Results 1 to 5 of 5

Thread: ComboBox doubles offered options after every refresh

  1. #1

    Thread Starter
    New Member
    Join Date
    Nov 2019

    ComboBox doubles offered options after every refresh

    I'm working on an excell program to keep track of work assignments. I have a problem with the combo box because every time I press the command button named "Promijeni zapis" (translate Change record) the list box changes but the combobox doubles offered options and I don't know why it happens. I will leave dropbox link if somebody could take a look. Thanx guys!

  2. #2
    PowerPoster techgnome's Avatar
    Join Date
    May 2002

    Re: ComboBox doubles offered options after every refresh

    Didn't take a look at it becaseu I'm not going to download sometnhing that you could have easily posted here (all we need is the codE)... but it sound like you're not clearing the combo box before re-adding items to it.

    * I don't respond to private (PM) requests for help. It's not conducive to the general learning of others.*
    * I also don't respond to friend requests. Save a few bits and don't bother. I'll just end up rejecting anyways.*
    * How to get EFFECTIVE help: The Hitchhiker's Guide to Getting Help at VBF - Removing eels from your hovercraft *
    * How to Use Parameters * Create Disconnected ADO Recordset Clones * Set your VB6 ActiveX Compatibility * Get rid of those pesky VB Line Numbers * I swear I saved my data, where'd it run off to??? *

  3. #3

    Thread Starter
    New Member
    Join Date
    Nov 2019

    Re: ComboBox doubles offered options after every refresh

    Ok i will post code

  4. #4

    Thread Starter
    New Member
    Join Date
    Nov 2019

    Re: ComboBox doubles offered options after every refresh

    Option Explicit
    Dim updateRow As Integer
    Private Sub cmbPrint_Click()
    ThisWorkbook.Sheets("Sheet1").PrintOut copies:=1
    End Sub
    Private Sub cmbSearch_Click()
    Dim i As Long
    Dim conn As ADODB.Connection, rs As ADODB.Recordset
    Dim var As String, where As String
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0 Xml;hdr=no"""
    For i = 1 To 8
        where = where & "F" & i & " Like '%" & txtSearch & "%' or "
    var = "Select * from [sheet1$] where " & Left(where, Len(where) - 4)
    rs.Open var, conn, adOpenStatic
    If rs.RecordCount > 0 Then
        With lstDisplay
            .RowSource = ""
            Do Until rs.EOF
                    .AddItem rs(0) & vbNullString
                    For i = 1 To .ColumnCount - 1
                        .List(.ListCount - 1, i) = rs(i) & vbNullString
        End With
        MsgBox "Nema rezultata"
    End If
    End Sub
    Private Sub cmbStatus_Change()
    End Sub
    Private Sub cmdAddData_Click()
    Dim wks As Worksheet
    Dim AddNew As Range
    Set wks = Sheet1
    Set AddNew = wks.Range("A65356").End(xlUp).Offset(1, 0)
    AddNew.Offset(0, 0).Value = txtRedniBroj.Text
    AddNew.Offset(0, 1).Value = txtNazivPismena.Text
    AddNew.Offset(0, 2).Value = txtBrojPismena.Text
    AddNew.Offset(0, 3).Value = txtPosaljitelj.Text
    AddNew.Offset(0, 4).Value = txtDatumZaprimanja.Text
    AddNew.Offset(0, 5).Value = txtDatumRazduzenja.Text
    AddNew.Offset(0, 6).Value = cmbPolicajac.Text
    AddNew.Offset(0, 7).Value = cmbStatus.Text
    Call UserForm_Initialize
    End Sub
    Private Sub txtDatumRazduzenja_Change()
    End Sub
    Private Sub txtDatumZaprimanja_Change()
    End Sub
    Private Sub txtNazivPismena_Change()
    End Sub
    Private Sub txtRedniBroj_Change()
    End Sub
    Private Sub txtStatus_Change()
    End Sub
    Private Sub UserForm_Click()
    End Sub
    Private Sub cmdDelete_Click()
    Dim i As Integer
    For i = 0 To Range("A65356").End(xlUp).Row - 1
        If lstDisplay.Selected(i) Then
        Rows(i + 1).Select
    End If
    Next i
    Call UserForm_Initialize
    End Sub
    Private Sub cmdExit_Click()
    Dim iExit As VbMsgBoxResult
    iExit = MsgBox("Želite li izaći", vbQuestion + vbYesNo, "Krim evidencije")
    If iExit = vbYes Then
    Unload Me
    End If
    End Sub
    Private Sub lstDisplay_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fnd As Range
    Set fnd = Range("a:a").Find(lstDisplay.Text)
    updateRow = fnd.Row
    txtRedniBroj.Text = fnd
    txtNazivPismena.Text = fnd.Offset(, 1)
    txtBrojPismena.Text = fnd.Offset(, 2)
    txtPosaljitelj.Text = fnd.Offset(, 3)
    txtDatumZaprimanja.Text = fnd.Offset(, 4)
    txtDatumRazduzenja.Text = fnd.Offset(, 5)
    cmbPolicajac.Text = fnd.Offset(, 6)
    cmbStatus.Text = fnd.Offset(, 7)
    End Sub
    Private Sub cmdUpdate_Click()
    Dim cel As Range
    Set cel = Cells(updateRow, 1)
    cel = txtRedniBroj.Text
    cel.Offset(, 1) = txtNazivPismena.Text
    cel.Offset(, 2) = txtBrojPismena.Text
    cel.Offset(, 3) = txtPosaljitelj.Text
    cel.Offset(, 4) = CDate(txtDatumZaprimanja.Text)
    cel.Offset(, 5) = CDate(txtDatumRazduzenja.Text)
    cel.Offset(, 6) = cmbPolicajac.Text
    cel.Offset(, 7) = cmbStatus.Text
    Call UserForm_Initialize
    End Sub
    Private Sub UserForm_Initialize()
    lstDisplay.ColumnCount = 8
    lstDisplay.RowSource = "A1:H65356"
    cmbPolicajac.AddItem ("")
    cmbPolicajac.AddItem ("Dragan Zagorac")
    cmbPolicajac.AddItem ("Zlatko Valentić")
    cmbPolicajac.AddItem ("Zlatko Magaš")
    cmbPolicajac.AddItem ("Goran Mikinac")
    cmbPolicajac.AddItem ("Danijel Klen")
    cmbPolicajac.AddItem ("Ivan Kopčić")
    cmbPolicajac.AddItem ("Milomir Marunić")
    cmbPolicajac.AddItem ("Domagoj Joskić")
    cmbPolicajac.AddItem ("Ivan Mrvićin")
    cmbPolicajac.AddItem ("Ivana Klen")
    cmbPolicajac.AddItem ("Anto Klarić Jozić")
    cmbPolicajac.AddItem ("Dubravka Opaćak")
    cmbStatus.AddItem ("")
    cmbStatus.AddItem ("U RADU")
    cmbStatus.AddItem ("DOVRŠENO")
    lblDatum.Caption = Format(Date, "ddd d mmm yyyy")
    updateRow = 8
    txtRedniBroj.Text = Cells(updateRow, 1).Text
    txtNazivPismena.Text = Cells(updateRow, 2).Text
    txtBrojPismena.Text = Cells(updateRow, 3).Text
    txtPosaljitelj.Text = Cells(updateRow, 4).Text
    txtDatumZaprimanja.Text = Cells(updateRow, 5).Text
    txtDatumRazduzenja.Text = Cells(updateRow, 6).Text
    cmbPolicajac.Text = Cells(updateRow, 7).Text
    cmbStatus.Text = Cells(updateRow, 8).Text
    Me.txtRedniBroj = Application.WorksheetFunction.Max(Range("A:A")) + 1
    End Sub

  5. #5
    Join Date
    Dec 2004

    Re: ComboBox doubles offered options after every refresh

    every time I press the command button named "Promijeni zapis"
    it would have been helpful if you had told us the name of the command button cmdupdate, so we know which code to read
    looks like it is because you initialize the userform again when you update, but the comboboxes are not cleared in either procedure

    change to
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
    lstDisplay.RowSource = "A1:H" & lrow
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts


Click Here to Expand Forum to Full Width