Hilfe Ich Brauche VBA unterstüzung

Option Explicit
'******************************************************************************
Function DoppelteEintraegeImRangeSuchen(ws As Worksheet, _
                                        GeaenderteZellen As Range, _
                                        Bereich As Range)
'*** ws               - Verweis auf das Arbeitsblatt
'*** GeaenderteZellen - Bereich einer/mehrerer Zelle/n, die geändert wurden
'*** Bereich          - zu überwachender Bereich
'***
'*** Makro dient zum Verhindern doppelter Einträge im überwachten Bereich
'***
'*** Leere Zellen werden nicht gepfüft.
'******************************************************************************

  Dim AdresseErsterFundort As String
  Dim b_DoppeltenEintragGefunden As Boolean
  Dim SuchBereich As Range, Zelle As Range, EineZelle As Range
  
 ->Leerer geanderter Bereich ?
  If GeaenderteZellen Is Nothing Then GoTo AUFRAEUMEN
  
 ->liegt die Zellen im überwachten Bereich ?
  If Application.Intersect(GeaenderteZellen, Bereich) Is Nothing Then GoTo AUFRAEUMEN
  
 ->den Bereich auf den benutzten Teil einschränken
  Set SuchBereich = Application.Intersect(ws.UsedRange, Bereich)
  
 ->kein Bereich im benutzten Bereich ?
  If SuchBereich Is Nothing Then GoTo AUFRAEUMEN
  
 ->Zellen nacheinander bearbeiten
  For Each EineZelle In GeaenderteZellen
  
   ->liegt die Zelle im überwachten Bereich ?
    If Application.Intersect(EineZelle, Bereich) Is Nothing Then GoTo AUFRAEUMEN
    
   ->Leere Zelle -> nicht suchen
    If EineZelle.Value <>  Then
    
     ->Suchen Inhalt von GeaenderteZelle
      Set Zelle = SuchBereich.Find(What:=EineZelle.Value, _
                                   LookIn:=xlValues, _
                                   LookAt:=xlWhole)
      If Not Zelle Is Nothing Then
        b_DoppeltenEintragGefunden = False
        If Zelle.Address <> EineZelle.Address Then
          b_DoppeltenEintragGefunden = True
        Else
          Set Zelle = SuchBereich.FindNext(Zelle)
          If Not Zelle Is Nothing Then
            If Zelle.Address <> EineZelle.Address Then
              b_DoppeltenEintragGefunden = True
            End If
          End If
        End If
        If b_DoppeltenEintragGefunden Then
         ->Ist mehr als eine Zelle in GeanderteZellen ?
          If GeaenderteZellen.Count = 1 Then
            MsgBox _
              Doppelter Wert in  & EineZelle.Address(False, False) &  ! & vbLf & _
              EineZelle.Address(False, False) &  wird gelöscht., vbCritical
            Application.EnableEvents = False
            EineZelle.Value = 
            EineZelle.Select
            Application.EnableEvents = True
          Else
            MsgBox _
              Doppelter Wert in  & EineZelle.Address(False, False) &  ! & vbLf & _
              Mehrere Werte wurden gleichzeitig geändert. & vbLf & _
              Bitte korrigieren Sie von Hand., vbCritical
            GoTo AUFRAEUMEN
          End If
        End If
      End If
    End If
  Next
AUFRAEUMEN:
  Set SuchBereich = Nothing: Set Zelle = Nothing: Set EineZelle = Nothing
End Function

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  
  Call DoppelteEintraegeImRangeSuchen(ActiveSheet, Target, _
                                      ActiveSheet.Range(C:F))
End Sub

Private Sub Workbook_Open()
  For Each ws In Worksheets
    Check (ws.Name)->Checkt alle Arbeitsmappen durch
  Next ws
End Sub


Private Function Check(Name As String) As Integer

 ->Feld wo die Fehlermeldung erscheint leeren
  Worksheets(Name).Range(W1:W65536).Value = 
  
 ->Torwart Spalte 12
  For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
    For colIndex = 12 To 12-> Spalte L
      With Worksheets(Name).Cells(rwIndex, colIndex)
        If .Value <= 32 And .Value >= 1 Then
          .Interior.ColorIndex = 0-> Hintergrund Transparent
        Else
          .Interior.ColorIndex = 3-> Hintergrund Rot
          Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Torwart darf zwischen 1 und 32 sein! 
        End If
      End With
    Next colIndex
  Next rwIndex
  
 ->Abwehr Spalte 13,14,15
  For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
    For colIndex = 13 To 15-> Spalte
      With Worksheets(Name).Cells(rwIndex, colIndex)
        If .Value <= 64 And .Value >= 33 Then
          .Interior.ColorIndex = 0
        Else
          .Interior.ColorIndex = 3
          Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Abwehr darf zwischen 33 und 64 sein! 
        End If
      End With
    Next colIndex
  Next rwIndex
  
 -> Mittelfeld Spalte 16,17,18,19
  
  For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
    For colIndex = 16 To 19-> Spalte
      With Worksheets(Name).Cells(rwIndex, colIndex)
        If .Value <= 96 And .Value >= 65 Then
          .Interior.ColorIndex = 0
        Else
          .Interior.ColorIndex = 3
          Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Mittelfeld darf zwischen 65 und 96 sein! 
        End If
      End With
    Next colIndex
  Next rwIndex
 -> Stürmer Spalte 20,21,22
  For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
    For colIndex = 20 To 22-> Spalte
      With Worksheets(Name).Cells(rwIndex, colIndex)
        If .Value <= 128 And .Value >= 97 Then
          .Interior.ColorIndex = 0
        Else
          .Interior.ColorIndex = 3
          Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Stürmer darf zwischen 97 und 128 sein! 
        End If
      End With
    Next colIndex
  Next rwIndex
 ->Prüfen ob die Werte mehrmals vorkommen
  
  
  
  
 
End Function