combobox ontdubbeld laten zien

HWV · 28 okt 2010

Beste

Ik gebruik een userform met een combobox die gegevens haalt uit de sheet Opslag Gegevens. In deze sheet staan meerdere crediteurennummers die ook dubbel voorkomen.
hoe kan ik er voor zorgen dat ik in de combobox enkel de juiste waarde`s krijg en niet de dubbelen.

Groet HWV

Code:

   On Error Resume Next
    Dim oRng As Range
    Set oRng = Sheets("Opslag Gegevens").Cells.Find(what:=Leverancier_naam.Value, lookat:=xlWhole)
        If oRng <> "" Then

            Leverancier.Value = oRng.Offset(0, -1).Value
           Leverancier_naam.Value = oRng.Offset(0, 0).Value
        End If

Jack Nouws · 28 okt 2010

Hallo HWV,

Kijk eens of je hier mee kunt werken

Code:

Private Sub UserForm_Initialize()
  Dim lng As Long
  Dim col As New Collection
  Dim Rng As Range
  
  Set Rng = Sheets("Blad1").Range("A1:A100")
  On Error Resume Next
  For lng = 1 To Rng.Rows.Count
    col.Add Rng.Cells(lng, 1).Value, Rng.Cells(lng, 1).Text
  Next
  On Error GoTo 0
  For lng = 1 To col.Count
    ComboBox1.AddItem col(lng)
  Next
  Set Rng = Nothing
End Sub

Met vr gr
Jack

HWV · 28 okt 2010

Ontdubbeld

Beste Jack,

Bedankt voor je bijdrage, het is inderdaad met deze code dat hij de dubbele eruit haalt en alleen de juite waarde laat zien.
Moet even goed in de code duiken om hem goed te gaan begrijpen (Als me dat gaat lukken

)

Maar jack , kan je hem nu ook dan gesorteerd van laag naar hoog ook laten tonen in de combobox leverancier ?

Code:

  Dim lng As Long
  Dim col As New Collection
  Dim Rng As Range
  
  Set Rng = Sheets("Opslag Gegevens").Range("M2:M4000")
  On Error Resume Next
  For lng = 1 To Rng.Rows.Count
    col.Add Rng.Cells(lng, 1).Value, Rng.Cells(lng, 1).Text
  Next
  On Error GoTo 0
  For lng = 1 To col.Count
    Leverancier.AddItem col(lng)
  Next
  Set Rng = Nothing

Warme bakkertje · 28 okt 2010

Harry, je hebt hiervoor 2 mogelijkheden.
1.Je kan de ongesorteerde array wegschrijven naar je werkblad, de ingebouwde sorteerfunctie van XL erop loslaten en de gesorteerde array terug inlezen in je combobox.
2.Door gebruik te maken van VBA de array in de array sorteren(klinkt raar, maar daar komt het op neer) en daarna de gesorteerde array inlezen in je combobox.
Het simpelste is mi echter mogelijkheid 1.

HWV · 28 okt 2010

klink goed maar erg ingewikkeld

Beste Rudi,

Bedankt voor je bericht maar "Harry" mag je veranderen in "Henk" :d

Zoals je schrijf klinkt het logisch, maar de uitvoering hiervan is mij denk iets te hoog gegrepen. Ik blijf het proberen maar kom geen stap verder.
laat ik het anders formuleren ik weet zelfs niet hoe ik moet beginnen

Groet HWV

Warme bakkertje · 28 okt 2010

Code:

Sub Fill_Combo()
  Dim lng As Long, col As New Collection, Rng As Range
  Set Rng = Sheets("Blad1").Range("A2:A500")
  On Error Resume Next
  For lng = 1 To Rng.Rows.Count
    col.Add Rng.Cells(lng, 1).Value, Rng.Cells(lng, 1).Text
  Next
  For lng = 1 To col.Count
  Cells(lng, 6) = col(lng)
  Next
  Cells(1, 6).CurrentRegion.Sort Cells(1, 6), xlAscending
  On Error GoTo 0
  sq = Cells(1, 6).CurrentRegion
    ComboBox1.List = sq
  Cells(1, 6).CurrentRegion.ClearContents
  Set Rng = Nothing
End Sub

Sorry, maar HWV en HSV liggen dichtbij elkaar en da's een Harry

De array wordt weggeschreven naar kolom F 'Cells(lng, 6) = col(lng)' en vervolgens gesorteerd. Daarna wordt deze terug in een array ingelezen 'sq = Cells(1, 6).CurrentRegion' en daarna wordt de CB gevuld 'ComboBox1.List = sq'

HWV · 28 okt 2010

Rudi,

Bedankt voor het meedenken, helaas geef hij een melding op SQ
Complieerfout
Een variabele is niet gedefineerd

Code:

  Dim lng As Long, col As New Collection, Rng As Range
  Set Rng = Sheets("Blad1").Range("A2:A500")
  On Error Resume Next
  For lng = 1 To Rng.Rows.Count
    col.Add Rng.Cells(lng, 1).Value, Rng.Cells(lng, 1).Text
  Next
  For lng = 1 To col.Count
  Cells(lng, 6) = col(lng)
  Next
  Cells(1, 6).CurrentRegion.Sort Cells(1, 6), xlAscending
  On Error GoTo 0
  [B][COLOR="red"]sq[/COLOR][/B] = Cells(1, 6).CurrentRegion
    ComboBox1.List = sq
  Cells(1, 6).CurrentRegion.ClearContents
  Set Rng = Nothing

Ik de code

Code:

Option Explicit

ook al verwijder maar blijf foutmelingen geven ?

Groet HWV

Warme bakkertje · 28 okt 2010

Zet bovenaan de code eens Dim sq as Variant bij

E v R · 28 okt 2010

Een iets andere invalshoek, eerst alles op de sheet regelen en dan inlezen:
Ik 'misbruik' kolom II hiervoor op het blad "Opslag Gegevens"

Code:

Private Sub UserForm_Initialize()

    With Sheets("Opslag Gegevens").Range("M1:M" & Cells(Rows.Count, "M").End(xlUp).Row)
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("II1"), Unique:=True
        With Sheets("Opslag Gegevens").Range("II2:II" & Cells(Rows.Count, "II").End(xlUp).Row)
            .Sort Key1:=Range("II2"), Order1:=xlAscending
            Me.[B][COLOR="blue"]Leverancier[/COLOR][/B].List = .Value
           .Offset(-1, 0).Resize(Cells(Rows.Count, "II").End(xlUp).Row).ClearContents
        End With
    End With

End Sub

Heet de ComboBox Leverancier? anders aanpassen, waarschijnlijk ook de reden dat de code van Warme Bakkertje die foutmelding geeft

HWV · 28 okt 2010

Rudi,
ik Heb het erbij gezet maar helaas niet werkend gekregen.

@ EVR
Jou code ook uitgeprobeerd maar krijg een melding:

Fout 1004 tijdens uitvoering
voor deze opdracht zijn minstens twee rijen brongegevens nodig. U kunt de opdracht niet gebruiken op één selectie in maar een rij. Ga op één van de volgende manieren te werk.
Als u een uitgebreide filter gebruikt, selcteer u een celberik dat ten minste twee rijen met gegeven bevat. Klik vervolgens opnieuw opde opdracht uitgebreide filter.

MM snap het niet echt

Groet HWV

E v R · 28 okt 2010

Die foutmelding krijg je als er niets staat in kolom M
++ Zorg ervoor dat er in cel M1 iets staat "crediteurennummer" bijvoorbeeld.

E v R · 28 okt 2010

oops, ik zie het al,

De sheet waar de gegevens opstaan is niet de aktieve....

probeer het zo eens:

Code:

Private Sub UserForm_Initialize()
With Sheets("Opslag Gegevens").Range("M1:M" & Sheets("Opslag Gegevens").Cells(Rows.Count, "M").End(xlUp).Row)
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Opslag Gegevens").Range("II1"), Unique:=True
        With Sheets("Opslag Gegevens").Range("II2:II" & Sheets("Opslag Gegevens").Cells(Rows.Count, "II").End(xlUp).Row)
            .Sort Key1:=Sheets("Opslag Gegevens").Range("II2"), Order1:=xlAscending
            Me.Leverancier.List = .Value
            .Offset(-1, 0).Resize(Sheets("Opslag Gegevens").Cells(Rows.Count, "II").End(xlUp).Row).ClearContents
        End With
    End With
End Sub

Warme bakkertje · 28 okt 2010

Nu met de juiste bladnaam, bereik en CB-naam

Code:

Sub Fill_Combo()
  Dim lng As Long, col As New Collection, Rng As Range
  Dim sq As Variant
  With Sheets("Opslag Gegevens")
  Set Rng = .Range("M2:M4000")
  On Error Resume Next
  For lng = 1 To Rng.Rows.Count
    col.Add Rng.Cells(lng, 1).Value, Rng.Cells(lng, 1).Text
  Next
  For lng = 1 To col.Count
    .Cells(lng, 6) = col(lng)
  Next
  .Cells(1, 6).CurrentRegion.Sort Cells(1, 6), xlAscending
  On Error GoTo 0
  sq = .Cells(1, 6).CurrentRegion
  Leverancier.List = sq
  .Cells(1, 6).CurrentRegion.ClearContents
  Set Rng = Nothing
  End With
End Sub

Jack Nouws · 28 okt 2010

met een hulpkolom...
niet fraai maar het is wel gesorteerd
het is maar een tip

Code:

Private Sub UserForm_Initialize()
  Dim lng As Long
  Dim col As New Collection
  Dim Rng As Range
  
  With Sheets("Opslag Gegevens")
    .[AM2:AM4000].Value = .[M2:M4000].Value
    .[AM2:AM4000].Sort .[AM2]

  Set Rng = .Range("AM2:AM4000")
  On Error Resume Next
  For lng = 1 To Rng.Rows.Count
    col.Add Rng.Cells(lng, 1).Value, Rng.Cells(lng, 1).Text
  Next
  On Error GoTo 0
  For lng = 1 To col.Count
    ComboBox1.AddItem col(lng)
  Next
  Set Rng = Nothing
    .[AM2:AM4000].Clear
  End With

End Sub

met vr gr
Jack

HWV · 29 okt 2010

Voor elkaar

Beste

@Rudi
Met jou code gebeurt er het volgende, bij het laden van de userform zorg hij er voor dat hij alle gegevens wist in de sheet opslag gegevens.

@Jack
Bedankt voor je inbreng, maar ik ga toch voor de oplossing E v R

@E v R
Dit werkt geweldig
Geen dubbelen meer en alles netjes gesorteerd van laag naar hoog

Ik ben blij met de uitkomst, ik waardeer de hulp erg.
iedereen bedankt voor de inzet. :thumb:

groet HWV

Jack Nouws · 29 okt 2010

Code:

Private Sub UserForm_Initialize()
With Sheets("Opslag Gegevens")
    .Columns("M").AdvancedFilter (2), , .[II1], True
    .Columns("II").Sort .[II2], Header:=xlGuess
     Me.ComboBox1.List = .Range("II2:II" & Sheets("Opslag Gegevens").Cells(Rows.Count, "II").End(xlUp).Row).Value
    .Columns("II").ClearContents
End With
End Sub

HWV · 29 okt 2010

Jack,

Bedankt voor je inspanning.
Het is inderdaad gelukt de code steeds weer korter te maken, voorheen zagen we SNB dit vaak doen, maar dit ziet er net zo goed uit.
Hellemaal top :thumb: , ik ga nu natuurlijk voor deze code.

Groet HWV

Warme bakkertje · 29 okt 2010

Met dit grote verschil dat snb steeds met nieuwe code aan kwam dragen terwijl dit exact dezelfde code is als die van EvR alleen een korter schrijfwijze

HWV · 29 okt 2010

rudi, Helemaal mee eens.

Groet HWV

Jack Nouws · 29 okt 2010

Warme bakkertje zei:
Met dit grote verschil dat snb steeds met nieuwe code aan kwam dragen terwijl dit exact dezelfde code is als die van EvR alleen een korter schrijfwijze

Wellicht dat het nog korter kan.
Alleen jammer dat snb niet zo vaak meer op dit forum aanwezig is.

met vrgr
Jack

combobox ontdubbeld laten zien

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Terugkerende gebruiker

Wij waarderen jouw privacy