Een regel kleuren op basis van waarde van een cel...Voorwaardelijke opmaak werkt niet

[velde046]

In het bijgesloten bestandje zit ik met een probleem.

Ik wil graag een regel kleuren op basis van de substring in een cel. Nu heb ik dat geprobeerd met voorwaardelijke opmaak, maar dat werkt niet,
Ten eerste kleurt dan niet de hele regel maar alleen de betreffende cel.
Ten tweede kan ik niet zoeken op substrings
Ten derde kan ik maar drie voorwaarden opgeven en ik heb meerdere nodig (5 in dit geval).

Hoe kan ik dit oplossen?

 

[Confictius]

Het werkt in zoverre, maar idd met max 3 voorwaarden. Klik het pijltje.

 

[Confictius]

Namens Excel Help:

 

[Wigi]

Bedoel je dit?

Heb uitgebreide code geschreven voor jou:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, rngChange As Range, rngColors As Range
    If Target.Count > 1 Then Exit Sub
    Set rngChange = Range("A2", Range("A2").End(xlDown))
    Set rngColors = Range("A20", Range("A20").End(xlDown))
    If Not Intersect(Target, Range("C2", Range("C2").End(xlDown))) Is Nothing Then
        For Each c In rngChange.Offset(, 2)
            If InStr(c, " ") = 0 Then
                On Error Resume Next
                c.EntireRow.Interior.ColorIndex = rngColors.Find(what:=c, LookIn:=xlValues, Lookat:=xlWhole).Offset(, 1).Interior.ColorIndex
                If Err.Number <> 0 Then GoTo naarhier
            Else
                On Error Resume Next
                c.EntireRow.Interior.ColorIndex = rngColors.Find(what:=Mid(c, 1, InStr(c, " ") - 1), LookIn:=xlValues, _
                    Lookat:=xlPart).Offset(, 1).Interior.ColorIndex
naarhier:
            End If
        Next
    End If
End Sub

Plak de code bij het blad waar je dit nodig hebt. Telkens als er iets wijzigt in de namen van de departementen, wordt de code uitgevoerd.

Wigi

 

[velde046]

Bedoel je dit?

Heb uitgebreide code geschreven voor jou:

...

Plak de code bij het blad waar je dit nodig hebt. Telkens als er iets wijzigt in de namen van de departementen, wordt de code uitgevoerd.

Wigi

Te gek het werkt als een trein. Ik ga niet doen alsof ik volledig snap hoe het werkt, maar zou het erg op prijs stellen als je een toelichting kunt geven hoe het script werkt, zodat ik er van kan leren en het in de toekomst zelf ook toe kan passen.

 

[Wigi]

maar zou het erg op prijs stellen als je een toelichting kunt geven hoe het script werkt, zodat ik er van kan leren en het in de toekomst zelf ook toe kan passen.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, rngChange As Range, rngColors As Range
    If Target.Count > 1 Then Exit Sub
    Set rngChange = Range("A2", Range("A2").End(xlDown))
    Set rngColors = Range("A20", Range("A20").End(xlDown))
    If Not Intersect(Target, Range("C2", Range("C2").End(xlDown))) Is Nothing Then
        For Each c In rngChange.Offset(, 2)
            If InStr(c, " ") = 0 Then
                On Error Resume Next
                c.EntireRow.Interior.ColorIndex = rngColors.Find(what:=c, LookIn:=xlValues, Lookat:=xlWhole).Offset(, 1).Interior.ColorIndex
                If Err.Number <> 0 Then GoTo naarhier
            Else
                On Error Resume Next
                c.EntireRow.Interior.ColorIndex = rngColors.Find(what:=Mid(c, 1, InStr(c, " ") - 1), LookIn:=xlValues, _
                    Lookat:=xlPart).Offset(, 1).Interior.ColorIndex
naarhier:
            End If
        Next
    End If
End Sub

If Target.Count > 1 Then Exit Sub

Als je tegelijk meer dan 1 cel verandert, gebeurt er niets.

Set rngChange = Range("A2", Range("A2").End(xlDown))
    Set rngColors = Range("A20", Range("A20").End(xlDown))

Geeft een naam aan 2 bereiken. End(xlDown) is de tegenhanger van Ctrl-pijltje naar beneden.

Offset(, 2)

dit wil zeggen: ga 2 kolommen naar rechts.

For Each c In rngChange.Offset(, 2)
...
Next

Je gaat door elke cel in het bereik dat 2 kolommen rechts ligt van het bereik rngChange.

If InStr(c, " ") = 0

gaat na of er een spatie voorkomt in c (eigenlijk, de tekst in de cel die je op dat moment van de loop onderzoekt).

c.EntireRow.Interior.ColorIndex = ...

je geeft een kleurtje aan de hele rij waarin cel c zicht bevindt (hele rij: dus EntireRow)

... rngColors.Find(what:=c, LookIn:=xlValues, Lookat:=xlWhole).Offset(, 1).Interior.ColorIndex

je past het kleurtje toe van de cel die gevonden wordt in het tweede bereik. Je zoekt op de inhoud van de cel c.

If Err.Number <> 0

Als er een fout opgetreden is, dan...

rngColors.Find(what:=Mid(c, 1, InStr(c, " ") - 1), LookIn:=xlValues, _
                    Lookat:=xlPart).Offset(, 1).Interior.ColorIndex

Je zit nu in een cel MET een spatie (Sales Global bijvb.). Dan zoek je in het tweede bereik op enkel het eerste deel, dus voor de spatie. Mid pakt gewoon een stuk uit iets anders.

Gesnapt?

Wigi

 

[Wigi]

Als mijn uitleg duidelijk was, zet de vraag dan op opgelost aub. Zoniet, geef aan waar je nog uitleg nodig hebt.

Wigi