Offset

[BART1988]

Allen

Ik heb onderstaande code, maakt de cel in kolom I rood als de waarde groter dan 0 is.
Maar deze zou ook in kolom A en B de cel moeten rood maken als in kolom I de waarde groter dan 0 is.
Doe ik dit met Offset, of?

Ps: als ik van >0, 0 maak, wordt dit terug origineel (kleur) na het uitvoeren van de macro.
Maar dan moet ik de knop terug indrukken, met welk event doet ie dit direct?

Sub test()
 
Dim i As Long
 
With ActiveWorkbook.Sheets(1)
 
    For i = 100000 To 1 Step -1
 
        If .Cells(i, "I") > "0" Then

            
           ActiveWorkbook.Sheets(1).Cells(i, "I").Cells.Interior.Color = vbRed
 
        End If
 
    Next i
 
End With

With ActiveWorkbook.Sheets(1)
 
    For i = 100000 To 1 Step -1
 
        If .Cells(i, "I") = "0" Then

            
           ActiveWorkbook.Sheets(1).Cells(i, "I").Cells.Interior.Color = xlNone
 
        End If
 
    Next i
 
End With
 
End Sub

Bedankt!

 

[edmoor]

Welke knop?
Gebruik een wisselknop.

 

[BART1988]

ik heb hier voor het testen een knop in de file staan....
moet als de code klaar is met Workbook Open en een Change event gebeuren.
Maar om te testen is dit handiger...

En dit alles pas liefst vanaf rij 2...
In bijlage bestand...

 

[edmoor]

Voor de ToggleButton, zoiets.

Private Sub ToggleButton1_Click()
    If ToggleButton1 Then
        Kleur = vbRed
    Else
        Kleur = xlNone
    End If
    
    For i = 1 To 100000
        If Cells(i, "I") > "0" Then
            Cells(i, "A").Cells.Interior.Color = Kleur
            Cells(i, "B").Cells.Interior.Color = Kleur
            Cells(i, "I").Cells.Interior.Color = Kleur
        End If
    Next i
End Sub

Andere events kan je dan zelf wel verzinnen.

 

[BART1988]

Kan dit niet allemaal gebeuren bij het openen van de file?
En bij het "live" wijzigen van de cel dat dit ook direct toepasbaar zal zijn?

 

[VenA]

Waarom geen voorwaardelijk opmaak ipv deze trage code?.

 

[BART1988]

Kan je mij iets tonen in code en voorwaardelijke opmaak?
Dan kan ik het verschil eens bekijken.

Dit is wat ik bedoel en het werkt (heb nu wel alle kolommen genomen), maar ik veronderstel dat code korter kan?
Alleen zou het van kleur veranderen moeten werken vanaf rij 2 en niet vanaf rij 1.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim I As Long

    For I = 1 To 100000
        If Cells(I, "I") > "0" Then
            Cells(I, "A").Cells.Interior.Color = vbRed
            Cells(I, "B").Cells.Interior.Color = vbRed
            Cells(I, "C").Cells.Interior.Color = vbRed
            Cells(I, "D").Cells.Interior.Color = vbRed
            Cells(I, "E").Cells.Interior.Color = vbRed
            Cells(I, "F").Cells.Interior.Color = vbRed
            Cells(I, "G").Cells.Interior.Color = vbRed
            Cells(I, "H").Cells.Interior.Color = vbRed
            Cells(I, "I").Cells.Interior.Color = vbRed
            Cells(I, "J").Cells.Interior.Color = vbRed
            Cells(I, "K").Cells.Interior.Color = vbRed
            Cells(I, "L").Cells.Interior.Color = vbRed
        End If
    Next I
    
    For I = 1 To 100000
        If Cells(I, "I") = "0" Then
            Cells(I, "A").Cells.Interior.Color = xlNone
            Cells(I, "B").Cells.Interior.Color = xlNone
            Cells(I, "C").Cells.Interior.Color = xlNone
            Cells(I, "D").Cells.Interior.Color = xlNone
            Cells(I, "E").Cells.Interior.Color = xlNone
            Cells(I, "F").Cells.Interior.Color = xlNone
            Cells(I, "G").Cells.Interior.Color = xlNone
            Cells(I, "H").Cells.Interior.Color = xlNone
            Cells(I, "I").Cells.Interior.Color = xlNone
            Cells(I, "J").Cells.Interior.Color = xlNone
            Cells(I, "K").Cells.Interior.Color = xlNone
            Cells(I, "L").Cells.Interior.Color = xlNone
        End If
    Next I

End Sub

 

[edmoor]

En je wilt dus dat die code draait bij iedere wijziging in iedere cel op ieder werkblad?
Dat lijkt me niet toch?
Maar is wel wat je nu doet.

 

[BART1988]

Er is maar één werkblad, waar ik dit op wil gebruiken, blad1
Doel: Als in kolom I een getal staat groter dan 0 of gelijk aan 0 wordt de kleur van de kolommen A tem L aanpassen. Naargelang de waarde dus...

 

[edmoor]

Dan is het dus ook niet nodig om bij de wijziging van 1 cel alle 100000 regels te doorlopen.
Dat kan dan eenmalig bij het openen van het document en daarna voor alleen de gewijzigde regel.
Is dat de bedoeling?

 

[BART1988]

Dat is helemaal wat ik bedoel
gewijzigde regel = cel in kolom I

 

[edmoor]

Ok. Probeer het dan eens zo.
Dit in de ThisWorkbook sectie:

Private Sub Workbook_Open()
    For i = 1 To 100000
        Range("A" & i & ":L" & i).Cells.Interior.Color = IIf(Cells(i, "I") > "0", vbRed, xlNone)
    Next i
End Sub

En dit achter het werkblad:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 9 And Target.Count = 1 Then
        Range("A" & Target.Row & ":L" & Target.Row).Cells.Interior.Color = IIf(Target.Value > "0", vbRed, xlNone)
    End If
End Sub

 

[BART1988]

Dit werkt.
Alleen als ik bv in 5 cellen tegelijk een 0 kopieer doet de macro niets...

 

[edmoor]

Dat klopt, zie Target.Count = 1.
Als je dat anders wilt krijg je ook andere code, maar je vraag was voor 1 cel.

 

[BART1988]

Sorry, ik bedoel dan eigenlijk onbeperkt....

 

[edmoor]

Dan dit achter het werkblad:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 9 Then
        For Each cl In Target
            Range("A" & cl.Row & ":L" & cl.Row).Cells.Interior.Color = IIf(cl.Value > "0", vbRed, xlNone)
        Next cl
    End If
End Sub

 

[VenA]

Gewoon met voorwaardelijke opmaak.

 

[BART1988]

Werkt! Prachtig!
Topic wordt gesloten.

 

[edmoor]

Kijk in ieder geval ook naar de oplossing van VenA.