Cellen kleuren middels VBA op basis van voorwaarden... (Geen voorwaardelijke opmaak)

[Jap3600]

Beste allen

Ik heb onderstaande code :

With Range("$C:$C").FormatConditions.Add(xlExpression, , "=ALS(EN(RIJ()>2;$A1=2);1;0)")
   .Interior.Color = RGB(217, 225, 242)
   ' Stoppen indien waar??
   .StopIfTrue = True
 End With

Hiermee heb ik een voorwaardelijke opmaak geprogrammeerd. Echter zou ik de cellen graag gewoon kleuren zodat deze ook in de cel eigenschappen te zien zijn. Alleen zo kan ik wat kopiëren naar een ander blad met deze opmaak.

Zou het daarom mogelijk zijn bovenstaande code aan te passen zodat deze niet als voorwaardelijke opmaak gemaakt wordt?

Had al zitten denken aan iets als onderstaande code maar de werkt alleen op basis van een waarde welke in een cel moet staan...

Dim c As Range

For Each c In Range("O3:O1509").Cells
    If c.Value = "B180" Then
        c.Interior.Color = RGB(217, 225, 242)
    
    End If

Next c

 

[Conseclusie]

Het is me niet helemaal helder wat precies je stopcriterium is, maar probeer deze eens:

For Each Cel In Range("C:C")
    If Cel.Row > 2 And Cel.Offset(, -2) = 2 Then
        Cel.Interior.Color = RGB(217, 225, 242)
    End If
Next Cel

 

[emields]

Weet wel dat je zonder voorbeeldbestand weinig reactie zal krijgen.

 

[Jap3600]

Beste

Als eerste dank voor jullie reactie @Conseclusie & @Emields

Een voorbeeld is inderdaad wenselijk.
Ik heb in bijlage dus een stukje van mijn bestand nagemaakt om de bedoeling duidelijker te maken.

Dit werkt dus helemaal zoals ik het graag wil hebben. Echter dien ik zeer vaak een kopie van dit geheel te kunnen kopiëren en plakken. Alle voorwaardelijke opmaak neemt deze dan niet mee waardoor dit wegvalt...
Dit zou ik graag willen aanpassen door de cellen te cellen werkelijk in te kleuren in plaats van te werken met een voorwaardelijke opmaak. Dan wordt dit namelijk wel mee overgenomen.

De code zoals hieronder staat zou ik dus graag willen vervangen zodat deze de cellen gaat inkleuren indien deze voldoen. Echter niet via een voorwaardelijke opmaak....

''  Vanaf hier zou ik onderstaande code willen vervangen dat deze echt
''  ingekleurd worden zonder VOORWAARDELIJKE OPMAAK
''

'1e Opmaak hier te plaatsen :

''Range("$D:$H,$J:$N").Activate
 With Range("$D:$H,$I:$N").FormatConditions.Add(xlExpression, , "=ALS(EN($J1=1;RIJ()>2);1;0)")
   ''.Interior.ColorIndex 35   'lichtgroen
   .Interior.Color = RGB(211, 211, 211) '255, 192, 0)
   ' Stoppen indien waar??
   .StopIfTrue = False
 End With
 

'2e Opmaak hier te plaatsen :
 With Range("$O:$O").FormatConditions.Add(xlExpression, , "=ALS(EN(RIJ()>2;OF($O1=""B290"";$O1=""B350""));1;0)")
   .Interior.Color = RGB(255, 124, 128)
   .StopIfTrue = True
 End With

'3e Opmaak hier te plaatsen :
  With Range("$O:$O").FormatConditions.Add(xlExpression, , "=ALS(EN(RIJ()>2;OF($O1=""B120"";$O1=""B180"";$O1=""B210"";$O1=""B240""));1;0)")
   .Interior.Color = RGB(204, 255, 153)
   .StopIfTrue = True
 End With
 
  
 '4e Opmaak hier te plaatsen :
  With Range("$L:$L").FormatConditions.Add(xlExpression, , "=ALS(EN(RIJ()>2;$P1<$L1;$P1>3000);1;0)")
   .Interior.Color = RGB(255, 80, 80)
   .StopIfTrue = True
 End With
 
'5e Opmaak hier te plaatsen :
  With Range("$C:$C").FormatConditions.Add(xlExpression, , "=ALS(EN(RIJ()>2;$A1=1);1;0)")
   .Interior.Color = RGB(226, 239, 218)
   End With

'6e Opmaak hier te plaatsen :
  With Range("$C:$C").FormatConditions.Add(xlExpression, , "=ALS(EN(RIJ()>2;$A1=2);1;0)")
   .Interior.Color = RGB(217, 225, 242)
   End With

 

[emields]

Komt dit in de buurt?

sommige regels van uw vo heb ik op het eerste gezicht niet zo goed begrepen (kleur in T1?) maar ik heb mijn best gedaan.

 

[Jap3600]

Beste Edmields

Als eerste hartelijk dank voor de code. Ik heb deze wat aangepast naar RGB kleuren en in de kolom O moeten de waarden "exact" overeenkomen. Maar met je hulp wat dit een kleine moeite. Ik ga het dadelijk proberen te implementeren in mijn bestand.
Hieronder nog even de code zoals ik deze nu heb staan.

P.S. de cel T1, benoemd als "kleur" is wat ik gebruik in een andere code om het bestand wat meer zichtbaar te maken. Heeft in basis niets met deze code te maken. Sorry voor de verwarring...

Sub Macro1()


''  Eerst wissen vorige inkleuring :
''' Alles blank "wit" maken
    Range("A3:P50").Interior.ColorIndex = xlNone '2 'WIT

For Each cell In Range("a3:a50")
 If cell.Value = 2 Then cell.Offset(, 2).Interior.Color = RGB(217, 225, 242)
 If cell.Value = 1 Then cell.Offset(, 2).Interior.Color = RGB(226, 239, 218)
 Next

 For Each cell In Range("l3:l50")
 If cell.Value > cell.Offset(, 4).Value Then cell.Interior.Color = RGB(255, 80, 80)
 If cell.Value <= cell.Offset(, 4).Value And cell.Value > 0 Then cell.Interior.Color = RGB(255, 255, 204)
 Next
 For Each cell In Range("o3:o50")
 If (cell.Value = "B120" Or cell.Value = "B180" Or cell.Value = "B210" Or cell.Value = "B240") And cell.Value > 0 Then cell.Interior.Color = RGB(204, 255, 153)
 If (cell.Value = "B290" Or cell.Value = "B350") And cell.Value > 0 Then cell.Interior.Color = RGB(255, 124, 128)
 Next
For Each cell In Range("j3:j50")
 If cell.Value = 1 Then cell.Offset(, -6).Resize(, 11).Interior.Color = RGB(211, 211, 211)
 If cell.Value >= 2 Then cell.Offset(, 1).Interior.Color = 65535
 Next
 End Sub