Änderung einer VBA-Gültigkeitsprüfung

Question

Hallo zusammen,
ich habe folgende Bitte.
Ich habe eine Gültigkeitsprüfung (schönen Dank nochmal an M.O.)in der überprüft wird, ob ein Name schon mal vorhanden ist.
Wenn ja meckert Excel "Name schon vorhanden!". Soweit alles prima.
Nach der Meldung wird der Name aber automatisch gelöscht und das ist der Knackpunkt. In der täglichen Arbeit hat sich herausgestellt, dass es besser wäre, wenn zwar die Meldung kommt, aber der Name stehen bleibt, damit man dann eine 2 oder 3 usw. (je nachdem wie oft der Name schon vorkam) anfügen kann und nicht den kompletten Namen noch einmal eingeben muss.
Jetzt die Bitte. Kann mir jemand die VBA-Prüfung so ändern, dass der Name nach der Prüfung stehen bleibt.
Hier die VBA-Prüfung:

Private Sub Worksheet_Change(ByVal Target As Range)
Set Bereich1 = Columns(3)
Set Bereich2 = Worksheets("Kundenliste alle").Columns(3)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Bereich1, Target) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Bereich1, Target.Value) + WorksheetFunction.CountIf(Bereich2, Target.Value) > 1 Then
MsgBox "Name schon vorhanden!", 16, "Fehler"
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
Target.Select
End If

End Sub

Danke und Gruß Flodnug

Answer 1

Hallo Flodnug,
löschen: Target.Value = ""
oder 'Target.Value = ""

Gruß
fedjo

Answer 2

Hallo fedjo.
danke erstmal für deine Antwort.
Habe die Zeile in diesem Teil gelöscht:
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True, so dass es jetzt so aussieht:
Application.EnableEvents = False
Application.EnableEvents = True.
Leider verschwindet der Name immer noch.
Habe ich was falsch gemacht?
Gruß flodnug

Answer 3

Private Sub Worksheet_Change(ByVal Target As Range)
Set Bereich1 = Columns(3)
Set Bereich2 = Worksheets("Kundenliste alle").Columns(3)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Bereich1, Target) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Bereich1, Target.Value) + WorksheetFunction.CountIf(Bereich2, Target.Value) > 1 Then
MsgBox "Name schon vorhanden!", 16, "Fehler"
Application.EnableEvents = False
Application.EnableEvents = True
Target.Select
End If

End Sub

Answer 4

Private Sub Worksheet_Change(ByVal Target As Range)
Set Bereich1 = Columns(3)
Set Bereich2 = Worksheets("Kundenliste alle").Columns(3)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Bereich1, Target) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Bereich1, Target.Value) + WorksheetFunction.CountIf(Bereich2, Target.Value) > 1 Then
MsgBox "Name schon vorhanden!", 16, "Fehler"
Target.Select
End If

End Sub

Answer 5

Hallo fedjo,
danke wieder für deine schnelle Antwort.
Aber es tut mir leid. Ich habe die Änderungen aus deiner letzten Nachricht übernommen (also ohne die Application-Zeilen) und dennoch verschwindet der Name immer noch.
Gruß flodnug

Answer 6

Hallo zusammen,
ich wollte mich nochmal in Erinnerung bringen und bitten, ob nochmal jemand auf mein Problem schauen kann, da ich immer noch keine Lösung gefunden habe.
Ich habe über das Wochenende fast jede einzelne Zeile gelöscht, jedoch ohne ein Ergebnis zu erzielen.
Ich hoffe jemand findet eine Lösung. Und das sage ich ausdrücklich eines nochmaligen extra Dankeschön an Fedjo für seine bisherige Hilfe.
Gruß Flodnug

Answer 7

Hallo Flodnung,

eigentlich müsste Fedjos Lösung aus Antwort 4 funktionieren:

Private Sub Worksheet_Change(ByVal Target As Range)
Set Bereich1 = Columns(3)
Set Bereich2 = Worksheets("Kundenliste alle").Columns(3)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Bereich1, Target) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Bereich1, Target.Value) + WorksheetFunction.CountIf(Bereich2, Target.Value) > 1 Then
MsgBox "Name schon vorhanden!", 16, "Fehler"
Target.Select
End If
End Sub

Dieser Code funktioniert in der vorhandenen Testdatei einwandrei, d.h. der eingegebene Name wird nicht gelöscht.

Gruß

M.O.

Answer 8

Hallo M.O.,
danke dass Du mir wieder hilfst.
Ich habe alles so abgeändert, wie Du mir nochmal /fedjo) bestätigt hast, aber es tut mir Leid. Es funktioniert nicht.
So bleibt mir nur nochmal den Link einzustellen und Dich zu bitten, nochmal in die Datei zu schauen.
Dort ist alles bereits abgeändert und funktioniert dennoch nicht.

http://www.xup.in/dl,10107490/KUNDENLISTE_2015_VBA_bearbeitet.xlsm/

Danke und Gruß Flodnug

Answer 9

Hallo Flodnung,
ist ja immer noch nicht gelöscht: Target.Value = ""

Gruß
fedjo

Answer 10

Hallo fedjo,
nicht böse sein. ich bin ja selbst schon am verzweifeln.
Habe deine genanannte Zeile raus gelöscht, aber der Eintrag verschwindet immer noch.
Wenn ihr bitte nochmal reinschauen könntet.
Danke vielmals für Eure Mühe.

http://www.xup.in/dl,84161440/KUNDENLISTE_2015_VBA_bearbeitet.xlsm/

Gruß Flodnug