Hallo Sabrina,

ich habe zwecks Test MasterDatei (Datei mit den beiden Prozeduren) im Blatt "TB02" 227 eingegeben. Da wird, da dieser Eintrag in der Masterdatei zum ersten mal eingetragen wurde, keine MsgBox gestartet. Grund: in der externen Datei existiert in Spalte C diese Nummer.

Trage ich jetzt im Blatt "TB01" eine 227 ein kommt MsgBox mit Hinweis dass diese Nummer bereits im Blatt "TB02" vergeben ist und entfernt den Eintrag. Mehr passiert hier nicht, weil dies so programmiert ist.

Was du mir bescheibst, kann ich egal was ich hier mache nicht nachvollziehen. Schlicht dies passiert so nicht.
Lade bitte ein Beispiel (beide Dateien in eine Zip packen), nebst eindeutiger Zuordnung in der Fehlerbeschreibung bitte nochmals hier hoch.

So kann ich mir den Vorgang in Ruhe analysieren, wenn es passiert.

vorsorglich hier mal noch die beiden Prozeduren von mir geändert auf frühe übergabe des Target.Value in Variable vTar (das hatte ich im vorherigen Artikel mitgeteilt und damit habe ich eben getestet):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim Wks As Worksheet, Z As Range, tmp, vTar ' vTar für den Fall das Target früh gelesen werden soll

    If Not Intersect(Target, Range("A10:A10000")) Is Nothing Then

        If Target.Text = "" Then Exit Sub

        Application.EnableEvents = False

        vTar = Target   ' frühes Übergeben des Target.Value

        If IsNumeric(Target.Value) Then Target = CDbl(Target.Value)

        For Each Wks In Sheets

            For Each Z In Wks.Range("A10:A10000").SpecialCells(xlCellTypeConstants)

                If Not IsError(Application.Match(Target, Z.Columns(1), 0)) And Z.Parent.Name <> Target.Parent.Name Then

                    tmp = Split(Right(Z.Address(0, 0, , True), Len(Z.Address(0, 0, , True)) - InStrRev(Z.Address(0, 0, , True), "]")), "!")

                    MsgBox "Die Lfd. Nr. " & Target & " ist bereits in Zelle: " & vbNewLine & tmp(1) & "    " & tmp(0) & " enthalten!", vbExclamation, "A C H T U N G"

                    Target = ""

                    Target.Select

                Else

                    If WorksheetFunction.CountIf(Wks.Columns(1), Target) > 1 Then

                        MsgBox "Die Lfd. Nr. " & Target & " ist bereits in Zelle: " & vbNewLine & Wks.Cells(Application.Match(Target, Wks.Columns(1), 0), 1).Address(0, 0) & "   " & Target.Parent.Name & " enthalten!", vbExclamation, "A C H T U N G"

                        Target = ""

                        Target.Select

                    End If

                End If

            Next

        Next

    End If

    Application.EnableEvents = True

    Call AbgleichExtern(vTar) 'für den Fall das Target spät gelesen werden soll dann: Call AbgleichExtern(Target)

End Sub



Sub AbgleichExtern(lfdNr As Variant)

    Dim rs As Object, arr, i&, k&, datN

    Set rs = CreateObject("ADODB.Recordset")

    With rs

        .CursorLocation = 3

        .CursorType = 3

        .Open "SELECT * FROM [" & extSh & "$]", "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0 xml"";" & "Data Source= " & extMapPath

        If (.EOF And .BOF) = False Then

            arr = .GetRows

        End If

        .Close

    End With

    Set rs = Nothing

    For i = LBound(arr, 2) To UBound(arr, 2)

        If IsNumeric(arr(2, i)) Then arr(2, i) = CDbl(arr(2, i))

        If arr(2, i) = lfdNr Then k = k + 1

    Next i

    datN = Right(extMapPath, Len(extMapPath) - InStrRev(extMapPath, "\"))

    If k = 0 Then MsgBox "Lfd. Nummer " & lfdNr & "  ist in Datei: " & datN & "! vorhanden", vbOKOnly, "Fehler!!!"

End Sub

Gruß Uwe