Hallo zusammen, habe mich an einem Programm versucht, das bei neuen Einträgen in eine Tabelle die alten Einträge überprüfen soll, und veraltete Einträge löschen soll. Zur Info: Nur die ersten 3 Spalten sind für mein Skript relevant. Die erste Spalte ist für jeden Eintrag befüllt (Inhalt unwichtig). In Spalte 2 wird markiert, ob der Eintrag "In Arbeit", also unvollständig, oder "Fertig", also final ist. In der 3ten Spalte wird eine Vertrags-ID angegeben. Die Liste wird nun laufend mit neuen Einträgen befüllt, manche davon sind noch nicht vollständig und somit als "in Arbeit" gelabelt. Neue Einträge zu einem bestimmten Vertrag werden als neue Zeile angelegt. Alles weitere ist im folgenden Skript kommentiert.

Sub AktuelleEintr()

' Es soll geprüft werden, ob zur entsprechenden Contract-ID bereits Einträge vorliegen.
' Ist der neue Eintrag als "Fertig" gelabelt UND gibt es bereits Einträge "In Arbeit"?
' In diesem Fall werden die "In Arbeit"-Einträge gelöscht und nur der aktuelle Eintrag beibehalten.

' Ablauf:
' Eintragung wird vorgenommen (auch mehrfach-Eintragungen möglich)
' Contract-ID wird überprüft
' Noch nicht vorhanden --> nichts passiert
' Bereits vorhandene Einträge mit Status auf "Fertig" --> nichts passiert
' Bereits vorhandene Einträge mit Status "In Arbeit" --> Einträge löschen

Dim z As Long, lZ As Long       'Variablen für meine Zeilen
Dim Contract As String          'Variable für meine Vertrags-ID
Dim Eintrag As range            'Range-Variable, die zum Auffinden bestimmter Vertrags-IDs verwendet wird
Dim Startw As String            'Startwert für späteren Loop

Worksheets("Gesamt DB").Select  'Ursprünglich eingeführt, da das Makro von einem anderen Sheet gelauncht werden soll

lZ = Worksheets("Gesamt DB").Cells(Rows.Count, 1).End(xlUp).Offset(-1, 0).Row   'lZ Ist meine letzte Zeile mit Eintrag. Der Offset kommt daher, da in der Tabelle stets eine Leerzeile am Ende steht

For z = lZ To 8 Step -1       'In Zeile 8 steht der erste Eintrag
    Contract = Worksheets("Gesamt DB").Cells(z, 3).Value            'Unterste Vertrags-ID wird als Contract deklariert
    If Worksheets("Gesamt DB").Cells(z, 2).Value = "Fertig" Then    'Wenn der neuste Eintrag als "Fertig" gelabelt ist...
        Set Eintrag = Worksheets("Gesamt DB").range("C8", Cells(Rows.Count, 3).End(xlUp)).Find(Contract)    'In meiner Liste nach Einträgen mit der selben Vertrags-ID suchen
        Startw = Eintrag.Address    'Startwert festlegen für späteren Loop
    
        Do
            If Eintrag.Offset(0, -1).Value = "In Arbeit" Then 'Wenn ein als "In Arbeit" gelabelter Eintrag besteht
                Rows(Eintrag.Row).Value = ""    'Wird die Zeile geleert
            End If
            Set Eintrag = Worksheets("Gesamt DB").range("C8", Cells(Rows.Count, 3).End(xlUp)).FindNext(Eintrag) 'Nächste übereinstimmernde Vertrags-ID wird gesucht
        Loop While Not Eintrag Is Nothing And Eintrag.Address <> Startw     'Soll einmal die ganze Liste durchchecken.
        
    End If
    
    If Worksheets("Gesamt DB").Cells(z, 1).Value = "" Then
        Rows(z).Delete  'Zum Schluss sollen die Zeilen, die geleert wurden, noch gelöscht werden
    End If
Next

End Sub

Problem: Ich bin mir nicht sicher, ob diese Loops gut genug geschlossen sind. Habe das Problem, dass sich bei Ausführung des Makros mein Excel aufhängt, ohne Fehlermeldung. Hat hier jemand ne Idee, wie das zu fixen wäre (oder eleganter zu lösen, bin leider VBA-technisch nicht gerade fit)? In etwa so sieht die Tabelle aus

In diesem Fall sollten hier Zeile 2 und 4 geleert und anschließend gelöscht werden