Wie kan mij helpen? Combobox probleem

Status
Niet open voor verdere reacties.

rkootje

Gebruiker
Lid geworden
24 okt 2011
Berichten
61
Hallo,
ben een klein beetje bekend met VBA en zit met een probleem. ik wil een formulier maken waar medewerkers die een verzoek indienen voor opvoeren van een artikel dit allemaal op dezelfde manier gaan doen. het e.e.a. is al wel gereed, echter zit ik met de comboboxen. op het blad "gegevens" heb ik in kolom C de artikel omschrijving met daarachter in kolom D de code die geplaatst moet worden in cel E8 op Blad 1 (productcode) in Kolom B heb ik een verzamelnaam geplaatst zodat je makelijker kunt filteren.
als je b.v. kiest voor gereedschap in de 1e combobox, dan moet je alleen de regels die achter "gereedschap staat" worden getoond in combobox 2, als daar een keuze wordt gemaakt, dient de daarbij behorende productcode vermeld te worden in de txtbox daarachter, de inhoud hiervan wordt dan op "blad 1" vermeld nadat op oke is gedrukt op het userform.

verder wil ik geen dubbele zien in de 1e combobox. wie kan me hiermee helpen, ben al druk aan het zoeken geweest, maar wat je zoekt zie je net weer nergens staan.
heb voor de duidelijkheid het bestandje toegevoegdBekijk bijlage Format aanvr. art.nr. demo.xlsm alvast bedankt!
 
Met dank aan snb.
Dit is 1 code voor je combobox 'Cob_ProductKeuze1'
Code:
Private Sub UserForm_Initialize()
Txt_DD.Value = Format(Date, "dd/mm/yyyy")
sn = Sheets(2).Range("B1:B150")
    With CreateObject("System.Collections.ArrayList")
        For Each cl In sn
            If cl <> "" And Not .contains(cl) Then .Add cl
        Next
        .Sort
        Cob_ProductKeuze1.List = Application.Transpose(.toarray())
    End With
End Sub
Voor meerdere codes voor het vullen van Comboboxen en Listboxen
LINK NAAR SITE
 
Compleet met iets andere insteek.

Code:
Private Sub Cob_ProductKeuze1_Change()
Cob_ProductKeuze2 = ""
Txt_artCode = ""
Set Geg = Sheets("Gegevens")
  arr = Geg.Columns(3).SpecialCells(2).Value
With CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    If Geg.Cells(i, 3).Offset(, -1) = Cob_ProductKeuze1.Value Then
     .Item(arr(i, 1)) = arr(i, 1)
    End If
     Next
   Cob_ProductKeuze2.List = Application.Transpose(.keys)
  End With
  Set Geg = Nothing
End Sub

Private Sub Cob_ProductKeuze2_Change()
Set Geg = Sheets("Gegevens")
  arr = Geg.Columns(2).SpecialCells(2).Resize(, 2).Value
For ii = 1 To UBound(arr)
  n = n + 1
If arr(ii, 1) & arr(ii, 2) = Cob_ProductKeuze1 & Cob_ProductKeuze2 Then GoTo einde
    Next
  Exit Sub
einde: Txt_artCode = Geg.Cells(n, 4)
End Sub

Private Sub UserForm_Initialize()
Dim Blad1 As Range
 Txt_DD.Value = Format(Date, "dd/mm/yyyy")
 With CreateObject("scripting.dictionary")
  For Each cl In Sheets("Gegevens").Columns(2).SpecialCells(2)
       .Item(cl.Value) = cl.Value
   Next cl
  Cob_ProductKeuze1.List = Application.Transpose(.keys)
 End With
End Sub
 
Hallo, beiden bedank voor je snelle reactie, maar bij beide code's krijg ik een foutmelding 70 , toegang geweigerd.
ik zal ongetwijfeld wat vergeten of fout doen, maar ik krijg het userform niet naar voren, dus kan het niet testen.
wat doe ik fout?
 
Omdat je een rowsource hebt opgegeven in je combobox. Deze moet je weghalen...
Selecteer je combobox op je userform en in het venster links moet het vakje naast de rowsource leeg zijn.
 
Sorry, helemaal niet gezien.
het werkt geweldig! geweldig bedankt voor jullie hulp!!!!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan