By a double click in listbox, a textbox to fill another UserForm

[dirk55]

Dear Forum Users,

This is my first post, I am very poor in English and I hope you understand my question.

I have a UserForm with 8 text boxes. (UserForm1) on the UserForm is a button that opens another UserForm
On this second UserForm (FrmMedewerkers) is also a listbox. (4 columns)
When I double click on a line, I want the value of this rule and the second column in the textbox6 of UserForm1 is put down

I use the following code

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim response As Long
 
   If ListBox1.ListIndex = -1 Then
        response = MsgBox("Celecteer een Relatie", vbOKOnly Or vbExclamation, Title:="Celecteer een Relatie")
        AllesZichtbaarButton_Click
        Inlezen
        UserForm_Initialize
    End If
 
 
    If ListBox1.ListIndex >= 0 Then
        response = MsgBox("Weet u zeker dat u  deze Medewerker wil selecteren?", vbYesNo, Title:="Medewerker selecteren?")
    If response = vbNo Then
        AllesZichtbaarButton_Click
        Me.ListBox1.Value = ""
        Inlezen
        UserForm_Initialize
 
 Else
 With ListBox1
 
 
 
  'CODE
 
 
End With
End If
End If
End Sub

Private Sub UserForm_Initialize()
On Error GoTo Foutmelding
  Dim sq As Variant, i As Integer, r As Integer, k As Integer, c As Range, sFilter As String, lRij As Long, Lijst As Variant
 
Application.WindowState = xlMinimized  'de "ShowModal" property van de form op False zetten
 
  With Worksheets("Sheet1")                                'je werkblad
    Set c = .Range("A2:A10000")                            'vrij grote range nemen in de 1e kolom
    lRij = Application.Evaluate("=MAX(IF(" & c.Address & "<>"""",ROW(" & c.Address & "),""""))")  'rijnummer van laatste niet-lege cel in dat bereik ook al is bereik gefilterd
    Set Bereik = .Range("A2:A" & lRij).Resize(, AantalKolommen)  'je gegevens (tot laatste niet-lege A-cel & 8 kolommen breed
    'om snelheid te winnen, wil je niet telkens de filter aanpassen, dat wordt gecheckt met het vlaggetje bOK
    'is het vlaggetje nog niet opgezet, dan wordt dit stukje doorlopen
    If Not bOK Then
      .AutoFilterMode = False                              'vorige filter uitzetten
      Bereik.AutoFilter                                    'nieuw filter installeren
    End If
    'opnieuw om snelheid te winnen, de 8 kolommen controleren of en op wat er gefilterd wordt en die gegevens naar de macro "AanpassenAutofilter" sturen met de juiste parameters
    For i = 1 To 8
      If Me("ComboBox" & i).ListIndex <> -1 Then           'iets gekozen in die combobox ?
        sFilter = Me("ComboBox" & i).Value                 'gebruik de combobox1 om te filteren
        Me("TextBox" & i).Value = ""                       'om verwarring te voorkomen wis je de textbox
      Else
'        sFilter = "*" & Me("TextBox" & i).Value & "*"      'gebruik de textboxes om te filteren
         sFilter = Me("TextBox" & i).Value & "*"            'gebruik de textboxes om te filteren
      End If
      AanpassenAutofilter i, sFilter
    Next
 
    'ook om snelheid te winnen voor de comboxes, die wil je ook niet telkens updaten, enkel als het nodig is
    If Not bCombos Then
      With Sheets("Blad2")                                 'dit is het hulpblad, best voor niets anders gebruiken  !!!!!!
        .Visible = xlVeryHidden                            'alleen zichtbaar voor VBA
        .UsedRange.Clear                                   'leegmaken
        Bereik.Copy .Range("a1")                           'je gegevens naar hier kopieren
        For i = 1 To 8                                     '1 voor 1 de 1e 8 kolommen langslopen
          .Columns("AA").Clear                             'hulpkolom wissen
          .Columns(i).AdvancedFilter xlFilterCopy, , .Range("AA1"), True  'unieke waarden naar hulpkolom kopieren
          .Columns("AA").Sort key1:=.Range("AA2"), Header:=xlYes  'oplopend sorteren
          .Range("AA1").Value = "(alles)"                  'kop weghalen
 
 
 
          Lijst = WorksheetFunction.Transpose(.Range("AA1:AA" & .Range("AA" & Rows.Count).End(xlUp).Row))  'waarden meegeven naar array
          Me("ComboBox" & i).List = Lijst
        Next
      End With
    End If
    'laatste stukje : zichtbare gegevens inlezen en naar listbox sturen
    If Not bOK Or Not bCombos Then
      i = WorksheetFunction.Subtotal(103, Bereik.Columns(1)) - 1  'aantal zichtbare rijen in die gegevens (let wel : kolom 1 bevat geen lege cellen, tel ook koprij niet mee)
      If i <= 0 Then
        ListBox1.Clear                                     'alles weggefilterd = geen gegevens
      Else
        ReDim sq(0 To i - 1, 0 To Bereik.Columns.Count - 1)  'array dimensioneren
        For Each c In Bereik.Columns(1).SpecialCells(xlVisible)  'alle zichtbare cellen in 1e kolom bereik aflopen
          If c.Row <> Bereik.Row Then
            For k = 0 To UBound(sq, 2)                     'alle kolommen aflopen
              sq(r, k) = c.Offset(, k).Value
            Next
            sq(r, 8) = c.Row                               'gemakshalve ook rijnummer meegeven
            r = r + 1
          End If
        Next
        ListBox1.List = sq                                 'listbox vullen
      End If
      bOK = True
    End If
  End With
  bOK = True
  bCombos = True                                           'filter en comboboxes zijn netjes ingelezen, zolang je niets aan de gegevens verandert, moeten die niet geupdatet worden
Exit Sub
Foutmelding:
          If Err.Number = 381 Then MsgBox ("Leesteken niet gevonden"), vbExclamation
        If teller > 0 Then Me("TextBox" & teller).Value = Left(Me("Textbox" & teller).Value, Len(Me("Textbox" & teller)) - 1)
         Resume Next
End Sub

Regards,

Dirk.

 

[Joe4]

We ask that if you are cross-posting, that you please provide a link to your other post: http://www.excelforum.com/excel-gen...stbox-a-textbox-to-fill-another-userform.html
(see rule #10 here: http://www.mrexcel.com/forum/showthread.php?t=99490).

 

[dirk55]

We ask that if you are cross-posting, that you please provide a link to your other post: http://www.excelforum.com/excel-gen...stbox-a-textbox-to-fill-another-userform.html
(see rule #10 here: http://www.mrexcel.com/forum/showthread.php?t=99490).

Thanks I was too late to do this message

Regards,

dirk

 

[Joe4]

Thanks I was too late to do this message

You can always post a reply back to your own thread.

 

[wigi]

Thanks I was too late to do this message

Regards,

dirk

And also too late for this crosspost?

http://www.worksheet.nl/forumexcel/...xtbox-vullen-door-ander-userform-listbox.html