Vba werkt niet

Status
Niet open voor verdere reacties.
T

Tsw

Gebruiker
Lid geworden
5 dec 2011
Berichten
183
Hallo,

Ik gebruik de volgende formule:
Code: 
Sub Kleuren()
With Sheets("Totaal")
Application.ScreenUpdating = False
For Each cl In .Range("C:ZZ").SpecialCells(2)
If cl.Value = "38x89" Then
cl.Interior.ColorIndex = 3
End If
Next

For Each cl In .Range("C:ZZ").SpecialCells(2)
If cl.Value = "38x120" Then
cl.Interior.ColorIndex = 4
End If
Next

For Each cl In .Range("C:ZZ").SpecialCells(2)
If cl.Value = "38x140" Then
cl.Interior.ColorIndex = 6
End If
Next

For Each cl In .Range("C:ZZ").SpecialCells(2)
If cl.Value = "38x170" Then
cl.Interior.ColorIndex = 7
End If
Next

End With

End Sub

Deze formule kleur alleen dat cellen waar letterlijk de tekst als "38x89" in staat.
Ik heb op deze pagina soms ook een verwijzing staan als =Invul_blad!E3

Hier komt de waarde "38x89" wel in te staan, maar deze kleur hij niet.
Waardoor komt dit?

gr.

Aanvulling:
Nu word de cel met een bepaalde waarde gekleurd bij mij, alleen wil ik eigenlijk dat de cel erboven ook die kleur krijgt. Kan dit ook in een VBA formule?
 
Laatst bewerkt:
Voor die cel boven de cel met de waarde zou ik dit toevoegen:

Code: 
cl.Offset(-1,0).Interior.ColorIndex = 6
 
.specialcells(2)<>.specialcells(-4123)


VBA is geen formule, maar code.

Code: 
Sub Kleuren()
  on error resume next

  For Each it In Sheets("Totaal").usedrange.columns(3).resize(,26)
     it.Interior.ColorIndex = application.match(it.value, array("","","38x89","38x120","","38x140","38x170"),0)
  Next
end sub
 
Laatst bewerkt:
Misschien wat leesbaarder voor TS. Tevens de voorgaande regel erbij en t/m kolom ZZ (702):

Code: 
Sub Kleuren()
    With Sheets("Totaal")
        Application.ScreenUpdating = False
        For Each cl In .Range("C:ZZ").SpecialCells(2)
            Select Case cl.Value
                Case "38x89":  ci = 3
                Case "38x120": ci = 4
                Case "38x140": ci = 6
                Case "38x170": ci = 7
            End Select
            If ci > 0 Then
                cl.Offset(-1, 0).Interior.ColorIndex = ci
                cl.Interior.ColorIndex = ci
                ci = 0
            End If
        Next
        Application.ScreenUpdating = True
    End With
End Sub
 
Laatst bewerkt:
We gaan toch geen volledige kolommen van c tot zz (254 ! ) cel voor cel testen ?
 
Dat bereik lijkt mij ook veel te groot, maar zo heeft TS het in #1 staan.

In plaats van:
Code: 
For Each cl In .Range("C:ZZ").SpecialCells(2)

Kan hij beter dit gebruiken:
Code: 
For Each cl In .UsedRange.SpecialCells(2)

Maar dan tellen de kolommen A en B ook mee.
 
Laatst bewerkt:
Werkt nu perfect.

Bereik was inderdaad veel te groot, nu werkt het goed.

Bedankt voor de hulp!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan