Worksheet_change soll nicht immer ausgeführt werde

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i          As Integer
Dim n          As Integer
Dim vergleich1 As String
Dim vergleich2 As String
Dim ergebnis   As String
Application.ScreenUpdating = False
ActiveSheet.Unprotect
On Error Resume Next
Application.StatusBar = "Starte Makro..."
For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row
If Target.Column  "Frei" And Cells(i, 9).Value  "Angaben unvollständig" And Not i = Target.Row Then
ergebnis = "Es wurden doppelte Dokumentennummern in den Zeilen " & i & " und " &  _
Target.Row & " gefunden!"
MsgBox ergebnis & vbCrLf & "Geänderte Zelle: " & Replace(Target.Address, "$", "") _
Application.StatusBar = ergebnis
Rows(i).Interior.ColorIndex = 4
Rows(Target.Row).Interior.ColorIndex = 3
Exit Sub
End If
End If
Next i
Cells.EntireColumn.AutoFit
Application.StatusBar = ""
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub