Toch nog even V LookUp aanhalen en afhankelijkheid Checkbox

Status
Niet open voor verdere reacties.

masala09

Gebruiker
Lid geworden
6 aug 2012
Berichten
886
Toch nog even een vraag en feitelijk een uitbreiding op VLookUp.

Ik wil de VLookUp afhankelijk maken van de checkbox en daarnaast 2 cellen in de label samenvoegen.

Nu is volgens mij het samenvoegen wel gelukt (al vind ik de code voor dat stukje wel erg lang, maar de checkbox moet feitelijk zodra ik deze aanvink meteen een wijziging geven in de gegevens. Bijvoorbeeld met de onderste code. Hier wil ik de contactpersoon via checkbox1 wel of niet zichtbaar laten maken en tevens worden de aanspreektitel en de naam van de persoon, beide in aparte kolommen samengevoegd en weergegeven in label3. Zodra ik de checkbox wijzig, blijft nu alles wat er is gezocht staan. Ik moet dan echt het bedrijf wegklikken en opnieuw kiezen om de wijziging daadwerkelijk te zien. Kan dit anders?

Code:
Private Sub UserForm_Initialize()
    ComboBox1.RowSource = "Bedrijfsnaam"
    
End Sub

Private Sub combobox1_Change()
    If CheckBox1 Then Label3 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 14, False) & " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 15, False)
    
End Sub

Private Sub CheckBox1_Change()

End Sub
 
Laatst bewerkt:
Zucht laat maar. Was simpeler dan ik weer dacht.

Als het korter kan dan gaarne.

Code:
Private Sub UserForm_Initialize()
    
    ComboBox1.RowSource = "Bedrijfsnaam"
    
End Sub

Private Sub combobox1_Change()
    
    
    Select Case CheckBox1
        Case Is = True
            Label3 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 14, False) & " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 15, False)
        Case Is = False
            Label3 = vbNullString
    End Select
    
    Select Case CheckBox2
        Case Is = True
            Select Case Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 5, False)
                Case Is = vbNullString
                    MsgBox ("Voor deze debiteur zijn er geen postbus gegevens bekend." & vbNewLine & vbNewLine & "Na het klikken op OK worden de standaard adresgegevens gebruikt.")
                    CheckBox2.Value = False
                    Label5 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 2, False)
                    Label6 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 3, False)
                    Label7 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 4, False)

                Case Is > vbnulstring
                    Label5 = " " & "Postbus" & " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 5, False)
                    Label6 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 6, False)
                    Label7 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 7, False)

            End Select
        Case Is = False
            Label5 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 2, False)
            Label6 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 3, False)
            Label7 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 4, False)
    End Select
    
    Label9 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 9, False)
    Label11 = " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 8, False)
    
End Sub

Private Sub CheckBox1_Change()

    Call combobox1_Change
    
End Sub

Private Sub CheckBox2_Click()

    Call combobox1_Change
    
End Sub
 
plaats een voorbeeld bestand met fictieve gegevens maar wel met de zelfde opbouw als jou bestand (als er maar een paar rijen met gegevens in staan) en je userform uiteraard
 
in plaats van meerdere keren Vlookup te gebruiken kun je ook 1 x Match gebruiken
Code:
Private Sub combobox1_Change()

    If ComboBox1 <> "" Then
    it = Application.WorksheetFunction.Match(ComboBox1, Sheets("Debiteuren").Columns(14), 0)
    kolnr = Array(2, 3, 4, 5, 6, 7, 8, 9)

    Select Case CheckBox1
        Case Is = True
            Label3 = " " & Cells(it, 14).Value & " " & Cells(it, 15).Value
        Case Is = False
            Label3 = vbNullString
    End Select
    
    Select Case CheckBox2
        Case Is = True
        
            Select Case Cells(it, 5).Value
                Case Is = vbNullString
                    MsgBox ("Voor deze debiteur zijn er geen postbus gegevens bekend." & vbNewLine & vbNewLine & "Na het klikken op OK worden de standaard adresgegevens gebruikt.")
                    CheckBox2.Value = False
                    
                    For i = 5 To 7
                    Me("Label" & i) = Cells(it, kolnr(i) - 5)
                    Next
                    
                Case Is > vbnulstring
                
                    For i = 5 To 7
                    Me("Label" & i) = Cells(it, kolnr(i))
                    Next
                    
                   
            End Select
        Case Is = False
        
            For i = 5 To 7
                Me("Label" & i) = Cells(it, kolnr(i) - 5)
            Next
            
    End Select
    
    Label9 = " " & Cells(it, 9)
    Label11 = " " & Cells(it, 8)
  End If
End Sub
 
iets korter,
Code:
Private Sub combobox1_Change()

 If ComboBox1 <> "" Then
    it = Application.WorksheetFunction.Match(ComboBox1, Sheets("Debiteuren").Columns(14), 0)
    kolnr = Array(2, 3, 4, 5, 6, 7, 8, 9)
    Label3 = IIf(CheckBox1, " " & Cells(it, 14).Value & " " & Cells(it, 15).Value, vbNullString)
    
    For i = 5 To 7
       Me("Label" & i) = Cells(it, kolnr(i) - 5)
    Next
       
    If CheckBox2 = True Then
      If Cells(it, 5).Value <> vbNullString Then
      
           For i = 5 To 7
              Me("Label" & i) = Cells(it, kolnr(i))
           Next
           
        Else
           MsgBox ("Voor deze debiteur zijn er geen postbus gegevens bekend." & vbNewLine & vbNewLine & "Na het klikken op OK worden de standaard adresgegevens gebruikt.")
           CheckBox2.Value = False
           
           For i = 5 To 7
              Me("Label" & i) = Cells(it, kolnr(i) - 5)
           Next
             
      End If
    End If
    Label9 = " " & Cells(it, 9)
    Label11 = " " & Cells(it, 8)
  End If
End Sub
 
He Pasan, dank je voor jouw input. Ik ga daar zeker eens mee aan de slag. Scheelt heel veel typewerk. Ik zat al eerder naar een manier te zoeken om niet telkens die regels voor VLookUp te herhalen. Ik had dit ook al eens geprobeerd via Dim, maar dat mocht niet baten. Zodoende dat ik eerst maar eens had gezorgd dat de code ging werken. Het "fine-tunen" komt daarna dan weer. Ik heb nu een mooi opzetje waar ik kan puzzelen.

Mijn dank.
 
Oke Pasan. Ik heb gepuzzeld, maar ik kom er niet uit. Onderstaand de code. Deze is veranderd daar er een paar zaken bij zijn gekomen die ik was vergeten. Na deze verandering ben ik gaan puzzelen.

Zou jij deze voor mij kunnen inkorten? Dan kan ik daarna eens kijken wat ik fout deed en wellicht beter zien wat je gedaan hebt.

Bijvoorbeeld bij Application.WorksheetFunction.Match(ComboBox1, Sheets("Debiteuren").Columns(14), 0)

Ik zie dat je hierin columns hebt gebruikt en daar tussen haakjes het getal 14 hebt geplaatst. Wat doet deze?

Rest van de vragen stel ik wel als ik jou antwoord heb gezien. Wellicht dat er dan voor mij al duidelijkheid ontstaat en een aantal vragen wegvallen. Dit om nodeloos communiceren voor te zijn.

In de tussentijd ga ik verder met de rest van het userform. Dit userform is ter vervanging van een werkblad: Factuur_Maken. Als ik dit formulier werkend heb dan kan ik het werkblad verwijderen en de verwijzingen gaan aanpassen.

Alvast bedankt.

Code:
Private Sub combobox1_Change()

    Dim DEEL1 As String
    Dim DEEL2 As String
    Dim DEBITEUR As String
    DEEL1 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 14, False)
    DEEL2 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 15, False)
    DEBITEUR = ComboBox1
    
    If ComboBox1 > vbNullString Then Frame3.Enabled = True

    Select Case CheckBox1
        Case Is = True
            Select Case DEEL2
                Case Is = vbNullString
                    MsgBox ("Voor " & DEBITEUR & " is er geen contactpersoon bekend.")
                    CheckBox1.Value = False
                Case Is > vbNullString
                    TextBox1 = DEEL1 & " " & DEEL2
            End Select
        Case Is = False
            TextBox1 = vbNullString
    End Select
    
    Select Case CheckBox2
        Case Is = True
            Select Case Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 5, False)
                Case Is = vbNullString
                    MsgBox ("Voor " & DEBITEUR & " zijn er geen postbus gegevens bekend." & vbNewLine & vbNewLine & "Na het klikken op OK worden de standaard adresgegevens geladen.")
                    CheckBox2.Value = False
                    TextBox2 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 2, False)
                    TextBox3 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 3, False)
                    TextBox4 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 4, False)

                Case Is > vbNullString
                    TextBox2 = "Postbus" & " " & Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 5, False)
                    TextBox3 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 6, False)
                    TextBox4 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 7, False)
            End Select
        Case Is = False
            TextBox2 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 2, False)
            TextBox3 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 3, False)
            TextBox4 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 4, False)
    End Select

    TextBox5 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 9, False)
    TextBox6 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 11, False)
    TextBox7 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 8, False)
    TextBox8 = Application.WorksheetFunction.VLookup(ComboBox1, Sheets("Debiteuren").Range("A4:U9000"), 12, False)
    
    With ComboBox2
        .Enabled = True
        .BackColor = &HFFFFFF
        .SetFocus
    End With

End Sub
 
Laatst bewerkt:
Columns(14) betekend niets meer dan de 14e kolom, als je de cursor in een woord zet van de code in de vba editor en je drukt op F1 krijg je bijna altijd je gezochte uitleg.
Je zegt dat je gaat puzzelen met mijn aangedragen code maar daar zie ik niks van terug in je vervolg vraag
Maar voor nu hou ik het ff voor gezien (voetbal laat geworden).

En Graag Een Voorbeeld Bestand anders moet ikzelf eerst alles opbouwen
 
Laatst bewerkt:
He Pasan. Ik voelde die vraag om een voorbeeld bestand al aankomen. Ik ben daar mee bezig. Ik moet hier alleen voor knippen en plakken etc. Dit omdat ik het werkelijke bestand informatie staat die wegens privacy redenen gevoelig is en derhalve niet mag worden geopenbaard.

Voor wat betreft de code klopt het inderdaad. Ik heb de verkeerde geplakt. Mijn fout. Sorry hiervoor. Echter het mooiste is..... de code die ik heb geprobeerd te maken heb ik niet meer. Ik heb het bestand niet goed opgeslagen. Ook hier zal ik aan werken om dat in orde te krijgen en zodoende ook hier te plaatsen.

Ik vraag even je geduld hiervoor en dan hoop ik dat je er op terug wilt komen. Het moet niet zo zijn dat jullie alles doen en ik lekker lui achter over tegen mijn vrouwtje aan gaat leunen. Dat doe ik wel bij mijn personeel. :D

Groet Maarten

En o ja voor ik het vergeet. Dat van die functie F1 weet ik. Ik moet er alleen weer even aan wennen dat deze het weer doet. Ik heb er onlangs een tijdje problemen mee gehad. Dit is ook opgelost. Een instelling stond toen verkeerd waardoor ik telkens online ging zoeken ipv op de computer zelf.
 
Laatst bewerkt:
Toch wel even snel een tweetal vraagjes aan jou Pasan.

Die array die jij in jouw code gebruikte bij: kolnr.
Verwees jij hiermee naar de kolomnummers van het datasheet?

En waar haalde jij die 14 vandaan voor het laatste kolom.
Greep jij die uit de lucht omdat je geen voorbeeldbestand had?
 
Laatst bewerkt:
Deze eigenschap of methode wordt niet ondersteund door dit object (Fout 438)

Dit krijg ik bij de code die ik heb omgebouwd. Let wel. Het verdere knip en plakwerk moet nog geschieden. Ik ben op het moment nog even de zaken aan het opzetten om deze aan jou door te zetten.

De code die ik tot nu toe heb is als onderstaand:

Code:
Private Sub combobox1_Change()

    Dim DEBITEUR As String
    DEBITEUR = ComboBox1
    
 If ComboBox1 <> vbNullString Then
    it = Application.WorksheetFunction.Match(ComboBox1, Sheets("Debiteuren").colums(15), 0)
    Kolnr = Array(2, 3, 4, 5, 6, 7, 8, 9, 11, 12)
    TextBox1 = IIf(CheckBox1, Cells(it, 14).Value & Cells(it, 15).Value, vbNullString)
    
    For i = 2 To 4
       Me("Textbox" & i) = Cells(it, Kolnr(i) - 2)
    Next
       
    If CheckBox2 = True Then
      If Cells(it, 5).Value <> vbNullString Then
      
           For i = 2 To 4
              Me("Textbox" & i) = Cells(it, Kolnr(i))
           Next
           
        Else
           MsgBox ("Voor " & DEBITEUR & " zijn er geen postbus gegevens bekend." & vbNewLine & vbNewLine & "Na het klikken op OK worden de standaard adresgegevens geladen.")
           CheckBox2.Value = False
           
           For i = 2 To 4
              Me("Textbox" & i) = Cells(it, Kolnr(i) - 2)
           Next
             
      End If
    End If
    
    TextBox5 = Cells(it, 8)
    TextBox6 = Cells(it, 9)
    TextBox7 = Cells(it, 11)
    TextBox8 = Cells(it, 12)
    
  End If
  
End Sub

De foutmelding geschied na het veranderen van de waarde van Combobox1. De foutmelding is als in de aanhef van deze post en dan wordt de coderegel achter: "it" geel.

Ik gebruik excel 2007.
 
Laatst bewerkt:
in jou code geef je aan label 3 de waarde uit kolom 14, dus ik nam aan dat in kolom 14 de primaire waarde gezocht moet worden, alle andere labels zouden hun waarde dan uit de zelfde rij moeten krijgen (tenminste dat neem ik aan)
Omdat uit jou code alleen gezocht wordt in de kolommen 2 tot 9 heb ik deze getallen in een Array gezet "kolnr"
En idd zonder voorbeeld bestand blijft het gissen
Het is ook handig (niet strikt noodzakelijk) om label1 de waarde uit kolom 1 te geven tot label 12 de waarde uit kolom 12 dit komt uiteindelijk het programmeren ten goede

Plaats een voorbeeld bestand zodat ik jou code kan testen
 
Laatst bewerkt:
dit is een typo
Code:
.colums
het moet zijn
Code:
.Columns
 
Komt ie Pasan.

Als je wilt, kijk dan ook even naar de reset functie. Ik krijg een conflict met combobox1_change(). Dit zal ook met de overige 4 comboboxen gebeuren zodra deze werkt.

Ik weet wel waar het door komt, maar ik krijg het niet opgelost. Althans ik weet er even geen oplossing voor.

Als je fouten ziet, pas ze gerust aan, maar geef wel even aan waarom als het even kan. Zo leer ik er ook weer iets van.

Alvast bedankt.

Bekijk bijlage FrmFactuurMaken.xlsm
 
Ja inderdaad dat klopt is een typo. Het bestandje is in ieder geval als in post 12. Deze heb ik in het bijgevoegd bestand, niet ingezet. Met knippen en plakken kom je er denk ik wel. Zo heb je in ieder geval beide codes.

Hoop dat ik zo aan je wens heb voldaan.
 
Laatst bewerkt:
Combobox1 rowsource = kolom 1 de gekozen waarde wil je in kolom 15 opzoeken.
In kolom 1 schrijf je "Test 1" in kolom 15 schrijf je "Test1" (zie de spatie) en dus wordt Test 1 niet gevonden.
Het volgende wat volgens mij niet klopt, in kolom 1 staat een naam, is de naam in kolom 15 de zelfde persoon???
Als het wel om de zelfde persoon gaat dan is 1 kolom toch voldoende
 
Ik heb je code volgens mij door. Hier en daar zit ik nog wel te puzzelen. Ik wacht af wat jij er van maakt. De genoemde fout heb ik er wel uit gekregen. De checkbox1 werd meteen aangesproken zodra de combobox1 wijzigde. Dat was niet de bedoeling. De bijbehorende waarden werden dus niet gevonden. Wel heb ik de match door.

Ik ga hier aan deze kant ook puzzelen. Kijken wat jij ervan maakt. Als ik ermee klaar ben dan zal ik ook eerlijk mijn uitkomst plaatsen.
 
Tot nu toe heb ik:

Code:
Private Sub combobox1_Change()

    Dim DEBITEUR As String
    DEBITEUR = ComboBox1
    
 If ComboBox1 <> vbNullString Then
    it = Application.WorksheetFunction.Match(ComboBox1, Sheets("Debiteuren").Columns(1), 0)
    Kolnr = Array(2, 3, 4, 5, 6, 7, 8, 9, 11, 12)
    Frame3.Enabled = True
    
    
    For i = 2 To 4
       Me("Textbox" & i) = Cells(it, Kolnr(i) - 2)
    Next
    
    If CheckBox1 = True Then
        TextBox1 = IIf(CheckBox1, Cells(it, 14).Value & Cells(it, 15).Value, vbNullString)
        Else: TextBox1 = vbNullString
        End If
        
        
    If CheckBox2 = True Then
      If Cells(it, 5).Value <> vbNullString Then
      
           For i = 2 To 4
              Me("Textbox" & i) = Cells(it, Kolnr(i))
           Next
           
        Else
           MsgBox ("Voor " & DEBITEUR & " zijn er geen postbus gegevens bekend." & vbNewLine & vbNewLine & "Na het klikken op OK worden de standaard adresgegevens geladen.")
           CheckBox2.Value = False
           
           For i = 2 To 4
              Me("Textbox" & i) = Cells(it, Kolnr(i) - 2)
           Next
             
      End If
    End If
    
    TextBox5 = Cells(it, 9)
    TextBox6 = Cells(it, 11)
    TextBox7 = Cells(it, 8)
    TextBox8 = Cells(it, 12)
    
  End If
  
    With ComboBox2
        .BackColor = &HFFFFFF
        .Enabled = True
        .SetFocus
    End With
    
End Sub

Volgens mij werkt het in het geheel nu..... Tevens de RESET werkt nu ook feilloos door enkel het aanpassen op jouw manier. Hiervoor kreeg ik bij reset een foutmelding. Nu is deze weg.

Heb jij nog op en aanmerkingen? Wellicht aanvullingen of verbeteringen in opzet van de gehele code?
 
Laatst bewerkt:
frame3 was enabled = false deze op true gezet (eigenschappen)
Verander
Code:
it = Application.WorksheetFunction.Match(ComboBox1, Sheets("Debiteuren").Columns(15), 0)
In
Code:
it = ComboBox1.ListIndex + 4
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan