Doppelte Namen in 2 Tabellenblättern anzeigen

Guten Tag,
ich habe nun schon ewig im Web gesucht, jedoch keine passende Lösung gefunden.
Ich habe eine Tabelle Namens "Terminer" mit 2 Tabellenblättern.
Das 1. Tabellenblatt heißt Transporter, dass 2. Termine.
Im 1. Tabellenblatt befindet sich eine Spalte Nachname (Spalte B) und 1 Spalte Vorname (Spalte C). Die Spalten werden von Hand gefüllt.
Im 2. Tabellenblatt gibt es diese beiden Spalten ebenfalls, auch in Spalte B und C.
Nun benötige ich einen Code, welcher mir eine Msg-Box mit Fehlermeldung (Bsp. Name schon in Tabellenblatt 1 eingetragen!)öffnet, wenn ich beispielsweise einen Namen + Vornamen in das 2. Tabellenblatt (Termine) eingebe, welcher im 1. Tabellenblatt schon vorhanden ist.
Schreibe ich ins Tabellenblatt 2 einen Namen, welcher in Tabellenblatt 1 steht, soll es synchron laufen, also auch eine Fehlermeldung erscheinen.
Gelöscht werden sollten die Daten nicht.
Ich hoffe ich konnte es einigermaßen plausibel erklären.
Danke schonmal im Vorraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'Define your variables. Dim ws As Worksheet, EvalRange As Range 'Set the range where you want to prevent duplicate entries. Set EvalRange = Range("A1:B20") 'If the cell where value was entered is not in the defined range, if the value pasted is _ larger than a single cell, 'or if no value was entered in the cell, then exit the macro. If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub If IsEmpty(Target) Then Exit Sub 'If the value entered already exists in the defined range on the current worksheet, throw _ an 'error message and undo the entry. 'If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then 'MsgBox Target.Value & " already exists on this sheet." 'Application.EnableEvents = False 'Application.Undo 'Application.EnableEvents = True 'End If 'Check the other worksheets in the workbook. For Each ws In Worksheets With ws If .Name Target.Parent.Name Then 'If the value entered already exists in the defined range on the current _ worksheet, throw an 'error message and undo the entry. If WorksheetFunction.CountIf(Sheets(.Name).Range("A1:B20"), Target.Value) > 0 _ Then MsgBox Target.Value & " already exists on the sheet named " & .Name & ".", _ _ 16, "No duplicates allowed in " & EvalRange.Address(0, 0) & "." Application.EnableEvents = False 'Application.Undo Application.EnableEvents = True Exit For End If End If End With Next ws End Sub

Bin erst jetzt wieder am PC...
Viele Kenntnisse habe ich leider auch nicht, aber im Rahmen meiner Möglichkeiten versuche ich halbwegs zu helfen.
Kannst du das evtl. so umbauen, dass du den kompletten Namen direkt in eine Zelle schreibst?
Wenn das geht, kannst du den Code so lassen, wie er ist.
Wenn nicht, müsste da tatsächlich jemand ran, der wirklich Ahnung von VBA hat. Das übersteigt auch meine Kenntnisse.
Der jetzige Code kommt auf jeden Fall in "Diese Arbeitsmappe", das stimmt.
Ich poste dir mal den Code. Füge den einfach mal in deiner Mappe ein und teste. Alles, wo ein ' vor steht, kannst du theoretisch löschen, ich habe aber alles aus dem Originalcode drin gelassen.

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Define your variables.
Dim ws As Worksheet, EvalRange As Range
'Set the range where you want to prevent duplicate entries.
Set EvalRange = Range("B:C")
'If the cell where value was entered is not in the defined range, if the value pasted is _
larger than a single cell,
'or if no value was entered in the cell, then exit the macro.
If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'If the value entered already exists in the defined range on the current worksheet, throw  _
_
an
'error message and undo the entry.
'If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
'MsgBox Target.Value & " already exists on this sheet."
'Application.EnableEvents = False
'Application.Undo
'Application.EnableEvents = True
'End If
'Check the other worksheets in the workbook.
For Each ws In Worksheets
With ws
If .Name  Target.Parent.Name Then
'If the value entered already exists in the defined range on the current _
worksheet, throw an
'error message and undo the entry.
If WorksheetFunction.CountIf(Sheets(.Name).Range("B:C"), Target.Value) > 0 _
Then
MsgBox Target.Value & " existiert schon auf Tabellenblatt " & .Name & ".",  _
_
_
16, "No duplicates allowed in " & EvalRange.Address(0, 0) & "."
Application.EnableEvents = False
'Application.Undo
Application.EnableEvents = True
Exit For
End If
End If
End With
Next ws
End Sub

Beliebteste Forumthreads (12 Monate)

Doppelte Namen in 2 Tabellenblättern anzeigen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread