Ekstra Betinget formatering i Excel vha. VBA

Skulle være muligt - er der anført andet end "Ferie" - "Syg" i de i nævnte celler (A1:M39).

Skal farven først sættes, når der skrives indhold i en af de nævnte celler?

Spørgsmål - er det baggrunds- eller skrift-farve du efterlyser?

Der står ikke andet end de førnævnte tekster: "Ferie", "Syg" ...
Det er baggrundsfarven som skal skifte.

Jeg må lige gentage det 1. spørgsmål: Skal farven først sættes, når der skrives indhold i en af de nævnte celler - eller i et samlet skud?

Nå men her er lidt inspiration - farver sættes i eet skud:
Her er de 3 første farver anvendt.............

Sub farveLæg()
    For Each celle In ActiveSheet.Range("A1:M39").Cells
        If celle.Text = "Ferie" Then
            celle.Interior.ColorIndex = 4          'Grøn
        Else
            If celle.Text = "Syg" Then
                celle.Interior.ColorIndex = 3      'Rød
            Else
                If celle.Text = "Arbejde" Then
                    celle.Interior.ColorIndex = 6  'Gul
                End If
            End If
        End If
    Next
End Sub

Af en eller anden grund så kan jeg ikke få det til at virke. Jeg har en forventning om, at når jeg har skrevet "Syg" i en celle og skifter til anden celle så bliver baggrundsfarven 'Rød' med det samme. Det var nok det du spurgte ind til med dit spørgsmål. Hvad skal jeg ændre i koden for at få den ønskede effekt.

Så skal det gøres på en lidt anden måde.....
Vender tilbage med forslag.

Rem Koden indlægges under relevante Ark
Rem ===================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tekst, farveNr
    If Not Intersect(Target, Range("A1:M39")) Is Nothing Then
        tekst = Target.Text
        farveNr = findFarve(LCase(tekst))
        If farveNr <> -1 Then
            Target.Interior.ColorIndex = farveNr
        End If
    End If
End Sub
Private Function findFarve(tekst)
    findFarve = -1
   
    If tekst = "ferie" Then
        findFarve = 4                      'Grøn
    Else
        If tekst = "syg" Then
            findFarve = 3                  'Rød
        Else
            If tekst = "arbejde" Then
                findFarve = 6              'Gul
            End If
        End If
    End If
End Function

Jeg får en fejl når jeg f.eks. skriver 'Syg' i en celle: "Expected End Function"

Har du fået den sidste linie i koden med: End Function

Fejl fundet ...

Tusind tak for hjælpen ... det virker præcis som ønsket.

Når teksten fjernes vil jeg gerne have at baggrundsfarven 'forsvinder'.
Jeg har forsøgt med
  If tekst = "  " Then
  findFarve = 2 'Hvid
... men det virker ikke ...

Selv tak - har dog følende bemærkninger:
1) Når du stiller spørgsmål skal du ikke kommenterer indlæg med et SVAR - men derimod med KOMMENTAR.
SVAR afgives af de deltagere, der mener at deres indlæg er en mulig løsning.
Hvis et SVAR opfylder det ønskede - så skal du ACCEPTERE vedkommendes svar.
Hvis vedkommende ikke har lagt et SVAR, men kun en KOMMENTAR - beder du vedkommende om et SVAR.

I dette spørgsmål har du "givet dig selv point" - det var nok ikke meningen - så hvis du vil give mig point - så skal du oprette et nyt spørgsmål under samme kategori og kald det: Point til Supertekst - og inde i selve spørgsmålet henviser du til dette spørgsmål via dets nummer: 837100 - så ved alle hvad det drejer sig om.
Når et spørgsmål først er accepteret kan andre ikke afgive svar hertil.

Du er ikke den første der har været i denne situation - så fat mod.... :-)

2) Din sidste kommentar skal jeg nok fikse...

Rem Koden indlægges under relevante Ark
Rem ===================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tekst, farveNr
    If Not Intersect(Target, Range("A1:M39")) Is Nothing Then
        tekst = Target.Text
       
Rem Test om celle-indhold er slettet                '<---tilføjelser
        If tekst = "" Then                          '<---
            Target.Interior.ColorIndex = xlNone    '<---
        Else                                        '<---
            farveNr = findFarve(LCase(tekst))
            If farveNr <> -1 Then
                Target.Interior.ColorIndex = farveNr
            End If
        End If                                      '<---
    End If
End Sub
Private Function findFarve(tekst)
    findFarve = -1
   
    If tekst = "ferie" Then
        findFarve = 4                      'Grøn
    Else
        If tekst = "syg" Then
            findFarve = 3                  'Rød
        Else
            If tekst = "arbejde" Then
                findFarve = 6              'Gul
            End If
        End If
    End If
End Function