bei Dateneingabe - Hinweis schon vorhanden

[Gast 123]

Hallo Joachim

es freut mich sehr das mein Code zufriedenstellend laeuft.  Das Jahr faengt gut an .....
Hier noch mal die Aenderung für Strasse, einfach ins Modul1 kopieren. Das ist alles.

Ich habe noch die Löschen Anweisung mit "Ja" (Nein) eingefügt. Da kann man selbst festlegen ob die Fehleingabe gelöscht werden soll oder nicht.

mfg  Gast 123

Code:

Public FamName As String
Public Vorname As String
Public GebDatum As Date
Public TSpalte As Long
Public TZeile As Long

Const Löschen = "Ja"   'Ja/Nein Option


'Modul zum Prüfen von vorhandenen Namen

Sub Prüfung()
Dim rFind As Range, Zeile As Long
Dim gFind As Range, Adr1 As String
Dim Strasse As String

   On Error GoTo Fehler
   'Vorname und Fam.Name suchen
   Set rFind = Columns("C").Find(What:=FamName, after:=Range("C1"), LookIn:= _
       xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
   If Not rFind Is Nothing Then Adr1 = rFind.Address: Zeile = rFind.Row
 
   'Vorname und Fam.Name beide vorhanden ??  Ende!!
   If TSpalte = 4 And TZeile > Zeile Then
      Strasse = Cells(TZeile, 5)
      Do
         If Cells(rFind.Row, "C") = FamName And _
            Cells(rFind.Row, "D") = Vorname And _
            Cells(rFind.Row, "E") = Strasse Then
            MsgBox "Dieser Familien Name und Vorname existiert bereits in Zeile:  " & rFind.Row
            'Datensatz nur bei "Ja" löschen
            If Löschen = "Ja" Then
               Cells(TZeile, 2).Resize(1, 6) = Empty  '6 Spalten löschen
               Cells(TZeile, 2).Activate: Exit Sub
            End If
         End If
         Set rFind = Columns("C").FindNext(after:=rFind)
      Loop Until Adr1 = rFind.Address
   End If
   
   'Ged.Datum suchen, wenn vorhanden!!
   If TSpalte = 7 And TZeile > Zeile Then
      GebDatum = Cells(TZeile, 7)
      Set gFind = Columns("G").Find(What:=GebDatum, after:=Range("G1"), LookIn:= _
          xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
      If Not gFind Is Nothing Then Adr1 = gFind.Address: Zeile = gFind.Row
   End If
   
   If TSpalte = 7 And Not gFind Is Nothing Then
      'Geb.Datum, Vorname und Fam.Name alle vorhanden ??  Ende!!
      Do
         If Cells(gFind.Row, "C") = FamName And _
            Cells(gFind.Row, "D") = Vorname Then
            MsgBox "Dieser Datensatz existiert bereits in Zeile:  " & rFind.Row
            'Datensatz nur bei "Ja" löschen
            If Löschen = "Ja" Then
               Cells(TZeile, 2).Resize(1, 6) = Empty  '6 Spalten löschen
               Cells(TZeile, 2).Activate: Exit Sub
            End If
         End If
         Set gFind = Columns("G").FindNext(after:=gFind)
      Loop Until Adr1 = gFind.Address
   End If
Fehler:
End Sub

[joba]

Hallo Gast 123,

nochmals: Vielen Dank! Das klappt super!
Ich freue mich, dass Du mir so geholfen hast.
Da kann ich mein Rentnerdasein richtig
genießen.

Herzlichen Gruß
Joachim