MsgBox in Suchfunktion
02.05.2021 19:36:20
Jannik
Im Folgenden Code passiert Folgendes:
In eine Suchzeile wird ein Geburtsdatum eingegeben.
Nun wird in einer Liste von Kontakten nach diesem Datum gesucht. Die Treffer werden in einer Listbox ausgegeben.
Wird nichts gefunden wird eine MsgBox gezeigt, die darauf hinweist, dass nichts gefunden wurde, und fragt, ob ein neuer Kontakt angelegt werden soll.
Nun zum Problem:
Die MsgBox taucht immer auf, auch wenn Kontakte gefunden werden. Ich komme nicht drauf wie ich das löse.
Es in die Suchfunktion zu schreiben bringt auch nichts, weil ich es dann für jede durchsuchte Zeile angezeigt bekomme.
Kann mir jemand helfen? :-/
Viele Grüße
Jannik
Public Sub CBsearchBirth_Click()
Dim neuerKunde As Integer
Dim birthSuchbegriff
Dim LetzteZeile, Suchbereich As Long
birthSuchbegriff = UFempfang.TBbirth
With Sheets("Kunden")
LetzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
If birthSuchbegriff = "" Then
MsgBox "Kein Datum eingegeben"
Else
For Suchbereich = 2 To LetzteZeile
If InStr(Cells(Suchbereich, 4), birthSuchbegriff) > 0 Then
Unload Me
UFelistebirth.Show vbModeless
UFelistebirth.ListBox1.AddItem _
Cells(Suchbereich, 1) & "; " & _
Cells(Suchbereich, 3) & " " & _
Cells(Suchbereich, 2) & "; " & _
Cells(Suchbereich, 4)
Else
End If
Next Suchbereich
'Wenn kein Datensatz gefunden:
neuerKunde = MsgBox("Kunde nicht vorhanden. Neu anlegen?", vbExclamation + vbYesNo + vbDefaultButton1, "Kunde nicht vorhanden")
If neuerKunde = vbYes Then
UFnewcustomer.Show vbModeless
Else
End If
End If
End With
End Sub