Betinget farve af række - afhængig af dato/deadline

Nej, det kan jeg ikke lige se - men det kan selvfølgelig være, der er nogle af de andre der har en god idé.
Du kan her finde lidt eksempler på hvordan man kan løbe sådan et dataark igennem og gøre forskellige ting med de enkelte linjer.
http://www.kursusmaterialer.dk/Excel%20VBA/Excel%20VBA%20-%20kode/Værktøjskasse.aspx

Send mig et eksempel på sådan et ark, så skal jeg skyde noget kode af, du kan arbejde videre på.

I excel er der en funktion der hedder betinget formatering under menuen formater. Og her kan du vælge hvad der skal ske når et felt er et værdi  etc

Det er rigtigt, men den tager kun 3 betingelser

Jeg har prøver den "standardiserede" formattering - men den er ikke helt god nok - men tak for forslaget her i varmen!

Denne makro lægges ind i arkets eget kodemodul (højreklik på en arkfane, vælg Vis Koder" og kopier den ind.)

Den reagerer på ændringer i området A5:A10, men det kan du selv ændre.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo finito
If Not Intersect(Target, Range("A5:A10")) Is Nothing Then
    Select Case Target.Value
        Case 1: Target.Interior.ColorIndex = 9
        Case 2: Target.Interior.ColorIndex = 1
        Case 3: Target.Interior.ColorIndex = 5
        Case 4: Target.Interior.ColorIndex = 4
        Case 5: Target.Interior.ColorIndex = 2
        Case Else
    End Select
End If
finito:
End Sub

Hej Bak
Jeg har prøvet dit forslag - men kan ikke helt gennemskue det. Du skal ikke lægge flere kræfter i det lige nu - jeg kommenterer yderligere hvis jeg behøver forklaring til dit oplæg. Jeg har fået et forslag fra Thor som ser fint ud. Thor lægger du dit svar ud?

Tja...
Jeg ved ikke hvor interessant det er for almenheden og den er ikke specielt køn, men her kommer den
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A4:G54")) Is Nothing Then
        Range(Target.Offset(0, -ActiveCell.Column + 1), Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6)).Interior.ColorIndex = 0
       
        If Not Target.Offset(0, -ActiveCell.Column + 1).HasFormula And Not IsEmpty(Target.Offset(0, -ActiveCell.Column + 1)) Then 'Tjekker at det ikke er en formel, så projektoverskrifter ikke farves
            Range(Target.Offset(0, -ActiveCell.Column + 1), Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6)).Interior.ColorIndex = 3
        End If
       
        ' Tildelt person
        If Not IsEmpty(Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 1)) Then
            Range(Target.Offset(0, -ActiveCell.Column + 1), Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6)).Interior.ColorIndex = 4
        End If
       
        ' Opfølgning - 3 dage til deadline
        If IsDate(Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6).Text) Then
            If CDate(Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6).Text) <= DateAdd("d", 3, Date) Then
                Range(Target.Offset(0, -ActiveCell.Column + 1), Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6)).Interior.ColorIndex = 5
            End If
        End If
       
        ' Deadline overskredet
        If IsDate(Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6).Text) Then
            If CDate(Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6).Text) < Date Then
                Range(Target.Offset(0, -ActiveCell.Column + 1), Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6)).Interior.ColorIndex = 6
            End If
        End If
       
        ' Aktivitet udført
        If Not IsEmpty(Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 5)) Then
            Range(Target.Offset(0, -ActiveCell.Column + 1), Target.Offset(0, -ActiveCell.Column + 1).Offset(0, 6)).Interior.ColorIndex = 7
        End If
    End If
End Sub

Forslag en implementeret - fungerer helt fint - tak for hjælpen.
God weekend
FLN