Sub Ampel()
Dim i As Variant
Sheets("MS Report").Activate
i = ThisWorkbook.Sheets("MS Report").Cells(Rows.Count, 1).End(xlUp).Row
For Each i In ThisWorkbook.Sheets("MS Report").Range("A2:A" & i)
If i.Offset(0, 9) = "" Then i.Offset(0, 9).Value = Date
If i.Offset(0, 7) = "" Then GoTo Skip
If i.Offset(0, 7) = "30.12.2026" Then GoTo Skip
If i.Offset(0, 7) = "**.**.2099" Then GoTo Skip
i.Offset(0, 10).Value = i.Offset(0, 7) - i.Offset(0, 9)
If i.Offset(0, 10).Value < 30 Then i.Offset(0, 10).Interior.ColorIndex = 6
If i.Offset(0, 10).Value < 0 Then i.Offset(0, 10).Interior.ColorIndex = 3
If i.Offset(0, 10).Value >= 30 Then i.Offset(0, 10).Interior.ColorIndex = 4
If (i.Offset(0, 9) - Date) > 0 Then
i.Offset(0, 10).Value = "actual Date in the Future"
i.Offset(0, 10).Interior.ColorIndex = 4
End If
Skip:
If i.Offset(0, 7) = "30.12.2026" Then
i.Offset(0, 10).Interior.ColorIndex = 7
i.Offset(0, 10).Value = "Dummy Date"
End If
If i.Offset(0, 7) = "**.**.2099" Then
i.Offset(0, 10).Interior.ColorIndex = 7
i.Offset(0, 10).Value = "Dummy Date"
End If
If i.Offset(0, 7) = "" Then
i.Offset(0, 10).Interior.ColorIndex = 7
i.Offset(0, 10).Value = "no planned Date"
End If
Next i
End Sub