Function InRange(Range1 As Range, Range2 As Range) As Boolean
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
Sub Worksheet_Change2(ByVal Target As Range, Optional ByVal Target As Range = Nothing)
Dim Zeile As Integer
Dim Datum As Variant
Dim Sheet As Variant
Dim Suche As Variant
Dim Suchspalte As Variant
Dim Suchzeile As Long
Dim Suchv As Variant
Dim Veranst As Variant
If InRange(ActiveCell, Range("F1:F")) Then
Sheet = ThisWorkbook.Name
Zeile = AktiveCell.Row
Farbe2 = Worksheets("Veranstaltungen").Cells(Zeile, 6).Interior.Color
On Error Resume Next
Rot2 = Farbe2 Mod 256
Farbe2 = (Farbe2 - Rot2) / 256
Gruen2 = Farbe2 Mod 256
Farbe2 = (Farbe2 - Gruen2) / 256
Blau2 = Farbe2 Mod 256
On Error GoTo 0
Veranst = Workbooks(Sheet).Worksheets("Veranstaltungen").Range("A" & Zeile).Value
Datum = Workbooks(Sheet).Worksheets("Veranstaltungen").Range("C" & Zeile).Value
Suchspalte = 11
Suche = Workbooks(Sheet).Worksheets("Planung").Cells(2, Suchspalte).Value
While Suche <> Datum
Suche = Workbooks(Sheet).Worksheets("Planung").Cells(2, Suchspalte).Value
Suchspalte = Suchspalte + 1
Wend
Suchspalte = Suchspalte - 1
Suchzeile = 3
Suchv = Workbooks(Sheet).Worksheets("Planung").Cells(Suchzeile, Suchspalte).Value
While Suchv <> Veranst
Suchv = Workbooks(Sheet).Worksheets("Planung").Cells(Suchzeile, Suchspalte).Value
If Suchv = "" Then
Exit Sub
End If
If Suchv = Veranst Then
Workbooks(Sheet).Worksheets("Planung").Cells(Suchzeile, Suchspalte) = ""
Workbooks(Sheet).Worksheets("Planung").Cells(Suchzeile, Suchspalte) = Veranst
End If
Suchzeile = Suchzeile + 1
Wend
End If
End Sub