evtl. hat am Weekend mal einer Zeit. Irgendwie klappt es nicht dass er die Duplikate nur aufzählt wenn in der 19. Spalte bei beiden Duplikaten "Belegt" steht. Ich glaub ich habs mir zu leicht gemacht. Keine Idee mehr ...
Danke und schönes Wochenende.!!!
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A2500")) Is Nothing Then
Dim lrow As Long
Dim LoI As Long
Dim Zeile As Integer
Dim Meldung As String
lrow = Cells(Rows.Count, 1).End(xlUp).Row
For LoI = 2 To lrow
If Cells(LoI, 2) "" Then
If Application.CountIf(Range("B2:B" & lrow), Cells(LoI, 2)) > 1 And Cells(LoI, 19) "Belegt" Then 'Hier klappts nicht so wie es soll
Meldung = Meldung & Cells(LoI, 1) & vbCrLf
End If
End If
Next LoI
MsgBox Meldung
End If
End Sub