dcsimg
Results 1 to 5 of 5

Thread: ComboBox doubles offered options after every refresh

  1. #1

    Thread Starter
    New Member
    Join Date
    Nov 2019
    Posts
    13

    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!
    https://www.dropbox.com/s/91hpx2cnu6...0v.4.xlsm?dl=0

  2. #2
    PowerPoster techgnome's Avatar
    Join Date
    May 2002
    Posts
    32,563

    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.

    -tg
    * 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
    Posts
    13

    Re: ComboBox doubles offered options after every refresh

    Ok i will post code

  4. #4

    Thread Starter
    New Member
    Join Date
    Nov 2019
    Posts
    13

    Re: ComboBox doubles offered options after every refresh

    Code:
    Option Explicit
    Dim updateRow As Integer
    Private Sub cmbPrint_Click()
    
    Application.Dialogs(xlDialogPrinterSetup).Show
    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 "
    Next
    var = "Select * from [sheet1$] where " & Left(where, Len(where) - 4)
    rs.Open var, conn, adOpenStatic
    If rs.RecordCount > 0 Then
        rs.MoveFirst
        With lstDisplay
            .RowSource = ""
            .Clear
            Do Until rs.EOF
                    .AddItem rs(0) & vbNullString
                    For i = 1 To .ColumnCount - 1
                        .List(.ListCount - 1, i) = rs(i) & vbNullString
                    Next
                rs.MoveNext
            Loop
        End With
    Else
        MsgBox "Nema rezultata"
    End If
    rs.Close
    conn.Close
    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
        Selection.Delete
    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
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,620

    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
    Code:
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
    lstDisplay.Clear
    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
    pete

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width