Vorab: meine VBA Kenntnisse beschränken sich auf Foren durchsuchen, Codeschnipsel kopieren und irgendwie passend machen. Dabei versuche ich das, was ich dort treibe durch Kommentare zu dokumentieren. Grundlegend funktioniert das Prinzip ganz gut, doch jetzt stoße ich auf ein mir unerklärliches Phänomän.


in einer Userform stelle ich eine Tabelle mit Kundendaten (Spalte1: Kundennummer, Spalte2 Kundenname, Spalte3 Strasse, etc.) dar. In einer Listbox wird ein Ausschnitt der Tabelle angezeeigt. Selektiere ich in der ListBox (ListBox Click Prozedur) einen Eintrag, werden Textboxen in der Userform mit den Daten des Datensatzes aus der Tabelle gefüllt. In die UserForm habe ich eine Suchfunktion implementiert, welche in der Tabelle einen Suchbefriff findet, in der Listbox selektiert und dann die Textfelder der UserForm mit Dateninhalten befüllt. Das funktioniert auch ohne Probleme.

Nun rufe ich über diese Userform eine weitere Userform auf, welche in gleicher Weise aufgebaut ist, jedoch eine andere Tabelle verarbeitet (Ähnlicher Aufbau : Kundennummer, Spalte2 Kundenname, Spalte3 andereDaten, etc.).
Ebenso befindet sich in dieser UserForm eine ListBox und eine Suchfunktion mit Exakt dem selben Code (lediglich die Bezeichnungen für Tabelle sind unterschiedlich). Hier wird der Suchbegriff in der Tabelle zwar gefunden, das Suchergebnis aber in der ListBox nicht selektiert...

Seit Tagen durchforste ich das Internet, Drehe und Verbiege den Code, leider ohne Erfolg. Ich hoffe, hier finde ich Unterstützung, die mir bei der Fehlerbeseitigung unter die Arme greift.

Hier der Code aus UserForm1

List Box Click Ereignis:

'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle2 heraus und tragen die Daten
'in die TextBoxen ein.

'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox1 = ""
TextBox1.Text = TextBox31
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""
TextBox13 = ""
TextBox14 = ""
TextBox15 = ""
TextBox16 = ""
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""
TextBox20 = ""
TextBox21 = ""
TextBox22 = ""
TextBox23 = ""
TextBox24 = ""
TextBox25 = ""
TextBox26 = ""
TextBox27 = ""
TextBox28 = ""
TextBox29 = ""
TextBox30 = ""

'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then

lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 2 drin steht
Do While Trim(CStr(Tabelle2.Cells(lZeile, 1).Value)) <> "" 'HIER?

'Wenn wir den Namen aus der ListBox1 in der Tabelle2 Spalte 2
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle2.Cells(lZeile, 2).Value)) Or ListBox1.Text = Trim(CStr(Tabelle2.Cells(lZeile, 1).Value)) Then 'HIER

'TextBoxen füllen
TextBox2 = Tabelle2.Cells(lZeile, 2).Value ' Trim(CStr(Tabelle2.Cells(lZeile, 2).Value))
TextBox1 = Tabelle2.Cells(lZeile, 1).Value
TextBox3 = Tabelle2.Cells(lZeile, 3).Value
TextBox4 = Tabelle2.Cells(lZeile, 4).Value
TextBox5 = Tabelle2.Cells(lZeile, 5).Value
TextBox6 = Tabelle2.Cells(lZeile, 6).Value
TextBox7 = Tabelle2.Cells(lZeile, 7).Value
TextBox8 = Tabelle2.Cells(lZeile, 8).Value
TextBox9 = Tabelle2.Cells(lZeile, 9).Value
TextBox10 = Tabelle2.Cells(lZeile, 10).Value
TextBox11 = Tabelle2.Cells(lZeile, 11).Value
TextBox12 = Tabelle2.Cells(lZeile, 12).Value
TextBox13 = Tabelle2.Cells(lZeile, 13).Value
TextBox14 = Tabelle2.Cells(lZeile, 14).Value
TextBox15 = Tabelle2.Cells(lZeile, 15).Value
TextBox16 = Tabelle2.Cells(lZeile, 16).Value
TextBox17 = Tabelle2.Cells(lZeile, 17).Value
TextBox18 = Tabelle2.Cells(lZeile, 18).Value
TextBox19 = Tabelle2.Cells(lZeile, 19).Value
TextBox20 = Tabelle2.Cells(lZeile, 20).Value
TextBox21 = Tabelle2.Cells(lZeile, 21).Value
TextBox22 = Tabelle2.Cells(lZeile, 22).Value
TextBox23 = Tabelle2.Cells(lZeile, 23).Value
TextBox24 = Tabelle2.Cells(lZeile, 24).Value
TextBox25 = Tabelle2.Cells(lZeile, 25).Value
TextBox26 = Tabelle2.Cells(lZeile, 26).Value
TextBox27 = Tabelle2.Cells(lZeile, 27).Value
TextBox28 = Tabelle2.Cells(lZeile, 28).Value
TextBox29 = Tabelle2.Cells(lZeile, 29).Value
TextBox30 = Tabelle2.Cells(lZeile, 30).Value

' die Daten des ausgewählten Kunden für den Ausdruck vorbereiten (in Tabelle1 schreiben)
Tabelle1.Cells(150, 2).Value = TextBox2 ' Kunde
Tabelle1.Cells(151, 2).Value = TextBox1 ' Kundennummer
Tabelle1.Cells(152, 2).Value = TextBox3 ' Straße
Tabelle1.Cells(153, 2).Value = TextBox4 ' PLZ
Tabelle1.Cells(154, 2).Value = TextBox5 ' Ort
Tabelle1.Cells(155, 2).Value = TextBox6 ' Land
Tabelle1.Cells(157, 2).Value = TextBox19 ' Telefon Nr.
Tabelle1.Cells(158, 2).Value = TextBox20 ' Fax
Tabelle1.Cells(159, 2).Value = TextBox21 ' E- Mail Adresse
Tabelle1.Cells(162, 2).Value = TextBox7 ' Kontoinhaber
Tabelle1.Cells(163, 2).Value = TextBox8 ' Bank
Tabelle1.Cells(164, 2).Value = TextBox9 ' Iban
Tabelle1.Cells(165, 2).Value = TextBox10 ' BIC
Tabelle1.Cells(166, 2).Value = TextBox14 ' Zahlungsbedingungen
Tabelle1.Cells(168, 2).Value = TextBox11 ' Steuernummer
Tabelle1.Cells(169, 2).Value = TextBox12 ' UST ID
Tabelle1.Cells(170, 2).Value = TextBox16 ' HRB Nr.
Tabelle1.Cells(172, 2).Value = TextBox25 ' LSA

If UserForm1.TextBox13.Text <> "" Then
UserForm1.TextBox13.BackColor = RGB(255, 255, 255)
Else
UserForm1.TextBox13.BackColor = RGB(255, 215, 215)
End If

Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist

End If

lZeile = lZeile + 1 'Nächste Zeile bearbeiten

Loop

End If

End Sub

Hier die Suchfunktion aus UserForm1:

Private Sub CommandButton5_Click() ' Suchen

Sheets("Tabelle2").Select
Dim lZeile As Long
' Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim i As Integer, ii As Integer
Dim vntList, strTxt As String, arrSelected()

lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
sFind = TextBox32.Value '("Bitte Suchbegriff eingeben:")

Set rng = Tabelle2.Cells.Find( _
what:=sFind, _
lookat:=xlPart, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Rows(rng.Row).Select

'Zwischenspeichern der gesuchten Zeile in Tabelle1 Zeile 1001
Selection.Copy Destination:=Tabelle1.Cells(1001, 1)

' selektiere das zwischengespeicherte Ergebnis (Tabelle1, Spalte2) im Inhalt der Listbox (Listbox Subroutine wird dann ausgeführt)
strTxt = Tabelle1.Cells(1001, 2)
vntList = ListBox1.List
ReDim arrSelected(ListBox1.ListCount - 1)
For i = 0 To ListBox1.ListCount - 1
For ii = 0 To ListBox1.ColumnCount - 1
arrSelected(i) = InStr(LCase(vntList(i, ii)), strTxt) > 0
If arrSelected(i) Then Exit For
Next
Next
With ListBox1
For i = 0 To .ListCount - 1
.Selected(i) = arrSelected(i)
Next
End With

Do
' Abfrage: Ist das Suchergebnis das gesuchte?
Application.Goto rng, True
If MsgBox( _
prompt:="Weiter suchen?", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then 'wenn NEIN, dann...

Exit Do
End If

'... suche in der nächsten Zeile weiter
Set rng = Cells.FindNext(after:=ActiveCell)
Rows(rng.Row).Select
Selection.Copy Destination:=Tabelle1.Cells(1001, 1) '.Value 'lZeile

If rng.Address = sAddress Then Exit Do 'wenn das Suchergebnis korrekt ist, selektiere den Fund in der Listbox (Listbox Subroutine wird dann ausgeführt)

strTxt = Tabelle1.Cells(1001, 2)
vntList = ListBox1.List
ReDim arrSelected(ListBox1.ListCount - 1)
For i = 0 To ListBox1.ListCount - 1
For ii = 0 To ListBox1.ColumnCount - 1
arrSelected(i) = InStr(LCase(vntList(i, ii)), strTxt) > 0
If arrSelected(i) Then Exit For
Next
Next
With ListBox1
For i = 0 To .ListCount - 1
.Selected(i) = arrSelected(i)
Next
End With

Loop ' stimmt das Ergebnis in der Listbox nicht? - suche erneut (nächste Zeile)
End If

MsgBox prompt:="Suche beendet"

End Sub


-------------------------------------------------------------------------------
und hier der Code aus UserForm2

List Box Click Ereignis:

'Klick auf die ListBox Ereignisroutine
Private Sub ListBox2_Click()
Dim lZeile As Long
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle5 heraus und tragen die Daten
'in die TextBoxen ein.

'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox50 = ""
' TextBox50.Text = TextBox31
TextBox51 = ""
TextBox52 = ""
TextBox53 = ""
TextBox54 = ""
TextBox55 = ""
TextBox56 = ""
TextBox57 = ""
TextBox58 = ""
TextBox59 = ""
TextBox60 = ""
TextBox61 = ""
TextBox62 = ""
TextBox63 = ""
TextBox64 = ""
TextBox65 = ""
TextBox66 = ""
TextBox67 = ""
TextBox68 = ""
TextBox69 = ""
TextBox70 = ""
TextBox71 = ""
TextBox72 = ""
TextBox73 = ""
TextBox74 = ""
TextBox75 = ""
TextBox76 = ""

'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox2.ListIndex >= 0 Then

lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 5 drin steht
Do While Trim(CStr(Tabelle5.Cells(lZeile, 1).Value)) <> "" 'HIER?

'Wenn wir den Namen aus der ListBox2 in der Tabelle5 Spalte 2
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!

If ListBox2.Text = Trim(CStr(Tabelle5.Cells(lZeile, 2).Value)) Or ListBox2.Text = Trim(CStr(Tabelle5.Cells(lZeile, 1).Value)) Then 'HIER

'TextBoxen füllen
TextBox51 = Tabelle5.Cells(lZeile, 2).Value ' Trim(CStr(Tabelle2.Cells(lZeile, 2).Value)) // Lieferantenname
TextBox50 = Tabelle5.Cells(lZeile, 1).Value 'Lieferantennummer
TextBox52 = Tabelle2.Cells(lZeile, 5).Value 'Ort
TextBox53 = Tabelle5.Cells(lZeile, 4).Value ' Einträge folgen...
TextBox54 = Tabelle5.Cells(lZeile, 6).Value
TextBox55 = Tabelle5.Cells(lZeile, 5).Value
TextBox56 = Tabelle5.Cells(lZeile, 7).Value
TextBox57 = Tabelle5.Cells(lZeile, 29).Value
TextBox58 = Tabelle5.Cells(lZeile, 20).Value
TextBox59 = Tabelle5.Cells(lZeile, 10).Value
TextBox60 = Tabelle5.Cells(lZeile, 11).Value
TextBox61 = Tabelle5.Cells(lZeile, 12).Value
TextBox62 = Tabelle5.Cells(lZeile, 16).Value
TextBox63 = Tabelle5.Cells(lZeile, 17).Value
TextBox64 = Tabelle5.Cells(lZeile, 18).Value
TextBox65 = Tabelle5.Cells(lZeile, 27).Value
TextBox66 = Tabelle5.Cells(lZeile, 26).Value
TextBox67 = Tabelle5.Cells(lZeile, 27).Value
TextBox68 = Tabelle5.Cells(lZeile, 19).Value
TextBox69 = Tabelle5.Cells(lZeile, 24).Value
TextBox70 = Tabelle5.Cells(lZeile, 21).Value
TextBox71 = Tabelle5.Cells(lZeile, 14).Value
TextBox72 = Tabelle5.Cells(lZeile, 15).Value
TextBox73 = Tabelle5.Cells(lZeile, 13).Value
TextBox74 = Tabelle5.Cells(lZeile, 22).Value
TextBox75 = Tabelle5.Cells(lZeile, 19).Value
TextBox76 = Tabelle5.Cells(lZeile, 9).Value

TextBox81 = Tabelle5.Cells(lZeile, 30).Value

' die Daten des ausgewählten Lieferanten für den Ausdruck vorbereiten (in Tabelle1 schreiben)
Tabelle1.Cells(150, 2).Value = TextBox51 ' Lieferant
Tabelle1.Cells(151, 2).Value = TextBox50 ' Lieferantennummer
Tabelle1.Cells(152, 2).Value = TextBox52 ' Einträge folgen...
Tabelle1.Cells(153, 2).Value = TextBox53 '
Tabelle1.Cells(154, 2).Value = TextBox54 '
Tabelle1.Cells(155, 2).Value = TextBox55 '
Tabelle1.Cells(157, 2).Value = TextBox56 '
Tabelle1.Cells(158, 2).Value = TextBox57 '
Tabelle1.Cells(159, 2).Value = TextBox58 '
Tabelle1.Cells(162, 2).Value = TextBox59 '
Tabelle1.Cells(163, 2).Value = TextBox60 '
Tabelle1.Cells(164, 2).Value = TextBox61 '
Tabelle1.Cells(165, 2).Value = TextBox62 '
Tabelle1.Cells(166, 2).Value = TextBox63 '
Tabelle1.Cells(168, 2).Value = TextBox64 '
Tabelle1.Cells(169, 2).Value = TextBox65 '
Tabelle1.Cells(170, 2).Value = TextBox66 '
Tabelle1.Cells(172, 2).Value = TextBox67 '

If UserForm2.TextBox56.Text <> "" Then
UserForm2.TextBox56.BackColor = RGB(255, 255, 255)
Else
UserForm2.TextBox56.BackColor = RGB(255, 215, 215)
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist

End If

lZeile = lZeile + 1 'Nächste Zeile bearbeiten

Loop

End If

End Sub
---------------------------------

und die Suchfunktion der UserForm2

Private Sub CommandButton20_Click() ' Suchen

Sheets("Tabelle5").Select
Dim lZeile As Long
' Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim i As Integer, ii As Integer
Dim vntList, strTxt As String, arrSelected()

lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
sFind = TextBox80.Value '("Bitte Suchbegriff eingeben:")

Set rng = Tabelle5.Cells.Find( _
what:=sFind, _
lookat:=xlPart, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Rows(rng.Row).Select

'Zwischenspeichern der gesuchten Zeile in Tabelle1 Zeile 1001
Selection.Copy Destination:=Tabelle1.Cells(2001, 1)

' selektiere das zwischengespeicherte Ergebnis (Tabelle1, Spalte2) im Inhalt der Listbox (Listbox Subroutine wird dann ausgeführt)
strTxt = Tabelle1.Cells(2001, 2)
vntList = ListBox2.List
ReDim arrSelected(ListBox2.ListCount - 1)
For i = 0 To ListBox2.ListCount - 1
For ii = 0 To ListBox2.ColumnCount - 1
arrSelected(i) = InStr(LCase(vntList(i, ii)), strTxt) > 0
If arrSelected(i) Then Exit For
Next
Next
With ListBox2
For i = 0 To .ListCount - 1
.Selected(i) = arrSelected(i)
.Selected(i) = arrSelected(i)

Next
End With

Do
' Abfrage: Ist das Suchergebnis das gesuchte?
Application.Goto rng, True
If MsgBox( _
prompt:="Weiter suchen?", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then 'wenn NEIN, dann...

Exit Do
End If

'... suche in der nächsten Zeile weiter
Set rng = Cells.FindNext(after:=ActiveCell)
Rows(rng.Row).Select
Selection.Copy Destination:=Tabelle1.Cells(2001, 1) '.Value 'lZeile

If rng.Address = sAddress Then Exit Do 'wenn das Suchergebnis korrekt ist, selektiere den Fund in der Listbox (Listbox Subroutine wird dann ausgeführt)

strTxt = Tabelle1.Cells(2001, 2)
vntList = ListBox2.List
ReDim arrSelected(ListBox2.ListCount - 1)
For i = 0 To ListBox2.ListCount - 1
For ii = 0 To ListBox2.ColumnCount - 1
arrSelected(i) = InStr(LCase(vntList(i, ii)), strTxt) > 0
If arrSelected(i) Then Exit For
Next
Next
With ListBox2
For i = 0 To .ListCount - 1
.Selected(i) = arrSelected(i)
Next
End With

Loop ' stimmt das Ergebnis in der Listbox nicht? - suche erneut (nächste Zeile)
End If

MsgBox prompt:="Suche beendet"

End Sub

Vorab schon mal Danke

Gruß
Piet