Ingevoerde waarden een kleur geven door VBA code

[wpayanda]

Goede dag allemaal,

Misschien hebben een aantal jullie mijn toppic bij Excel ook gezien. Omdat ik verder niet uit kwam met gewone voorwaardelijke opmaak functie van excel heb ik besloten om mijn probleem op te lossen met behulp van VBA. In de bijgevoegde excelfile kunt u zien hoe ver ik ben. Nu heb ik echter de volgende problemen:

1- Ik wil dat de VBA code de gehele kolom A bekijkt en als ik in een van de cellen een letter kies dat hij de ingevoerde waarden in desbetreffende rij gaat vergelijken met de tolleranties die ik in een andere sheet heb opgegeven en aan de hand daarvan de ingevoerde waarden een kleur geeft. Dus als ik in A1 voor letter A kies, dan moeten de waarden ,in B1, tussen 2 en 5 groen worden, groter dan 5 en kleiner dan 2 is rood en als 2 en 5 ingevoerd worden dan is het geel!

2- De gekozen letter krijgt kleur rood, dat moet echter zwart blijven

(eventueel als het mogelijk is: als ik iets ingegeven heb en de letter verander dan moet de rij automatisch geupdate worden. Bijvoorbeeld heb ik eerst voor "A" gekozen en alle gegevens ingevoerd en later het letter "A" vervang door het letter "B" dan moeten de al ingegeven waarden van kleur gaan veranderen omdat letter "B" een andere tol.bereik heeft.)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Worksheets("Test").Range("A:A").Value = "A" Then
With Target
            Select Case .Value
                Case Worksheets("Tol.").Range("B2").Value To Worksheets("Tol.").Range("C2").Value: .Font.colorindex = 4
                Case Is > Worksheets("Tol.").Range("C2").Value: .Font.colorindex = 3
                Case Is < Worksheets("Tol.").Range("B2").Value: .Font.colorindex = 3
                Case Is = Worksheets("Tol.").Range("B2").Value: .Font.colorindex = 6
                Case Is = Worksheets("Tol.").Range("C2").Value: .Font.colorindex = 6
                Case Else: .Interior.colorindex = xlNone
            End Select
        End With
        End If
        
If Worksheets("Test").Range("A:A").Value = "B" Then
With Target
            Select Case .Value
                Case Worksheets("Tol.").Range("B3").Value To Worksheets("Tol.").Range("C3").Value: .Font.colorindex = 4
                Case Is > Worksheets("Tol.").Range("C3").Value: .Font.colorindex = 3
                Case Is < Worksheets("Tol.").Range("B3").Value: .Font.colorindex = 3
                Case Is = Worksheets("Tol.").Range("B3").Value: .Font.colorindex = 6
                Case Is = Worksheets("Tol.").Range("C3").Value: .Font.colorindex = 6
                Case Else: .Interior.colorindex = xlNone
            End Select
        End With
        End If
        

        
End Sub

Alvast bedankt voor de hulp,

 

[wpayanda]

hoe kan ik ervoor zorgen dat de code alleen de rij gaat controleren die net ingevuld is?? dus als ik in A1 een letter heb gekozen dat de code de hele rij 1 gaat controleren en kijken wat de voorwaarden voor elke kolom is?misschien als ik dat weet dat ik dan de rest van de code kan uitpuzzelen.

 

[Cheetahke]

Hallo wpayanda,

Ik ben je voorbeeld eventjes aan het bekijken. Misschien kan ik je wel een beetje helpen, omdat ik onlangs iets vergelijkbaars in elkaar heb gestoken. Zodra het aangepast is vind je je bestandje hier terug.

Groetjes,

Cheetahke

 

[wpayanda]

ok Cheetahke, alvast bedankt voor de moeite. ik ben benieuwd! :thumb:

 

[Cheetahke]

Hallo wpayanda,

Hier je bestandje. Bekijk het eens. Als je nog vragen hebt, hoor ik het wel.

Groetjes

 

[wpayanda]

Cheetahke hartelijk bedankt voor je hulp. het is inderdaad wat ik moest hebben en het werkt perfect. NU is het zo dat ik de toleranties op een andere sheet heb staan en wil daarnaartoe verwijzen. ik denk dat ik dan het volgende kan gebruiken:

Case Worksheets("Tol.").Range("B3").Value To Worksheets("Tol.").Range("C3").Value 

enz.

en als ik ipv van de cel ernaast een cel in een andere kolom, bijvoorbeeld kolom C dezelfde rij, wil laten controleren dan kan ik

Target.Offset(0, 1).Value

veranderen in

Target.Offset(0, 2).Value

neem ik aan.

graag zie ik jou reactie terug.

 

[Cheetahke]

Als je naar een andere kolom wilt verwijzen kun je dat inderdaad doen met volgende code:

Target.Offset(0,2).Value

Als je meer kolommen wilt doorlopen, kun je volgende code gebruiken:

For lKolom = 1 to 10
     Target.Offset(0,lKolom).Value
Next

Voor de vergelijking kun je inderdaad jouw code gebruiken, maar die zul je toch nog moeten aanpassen. Ik heb die code getest, en ik krijg voor de waarde 5 de kleur rood ipv geel (zoals je gevraagd hebt).
Mvg,

 

[wpayanda]

Goede morgen Cheetahke,

je hebt inderdaad gelijk, mijn code werkt niet, ik krijg ook de hele tijd rood waar ik groen of geel moet krijgen. ik moet even uitzoeken waar het aan ligt.

En de naar andere kolom verwijzen doet is ook niet helemaal, weet jij misschien waarom? hij blijft de hele tijd kolom A te wijzigen.

 

[wpayanda]

ik heb nu het volgende probleem, onderstaande code gebruik ik om naar kolom "AC" te verwijzen vanuit colom "C" maar het werkt niet zoals het moet. Als ik in kolom "C" voor letter "H" kies en in kolom "AC" een getal invoer moet ik nog een keer in kolom "C" letter "H" kiezen om de kleur in kolom "AC" te veranderen. hij verandert de kleur niet automatisch na het invoeren van het getal in kolom "AC".

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim sWaardeTarget As String
    Dim iWaardeCelNaastTarget
    
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        If Not IsEmpty(Target.Value) Then
        
            sWaardeTarget = CStr(Target.Value)
            Select Case sWaardeTarget
               
                Case "H"
                    
                    If IsNumeric(Target.Offset(0, 26).Value) Then
                        iWaardeCelNaastTarget = CInt(Target.Offset(0, 26).Value)
                               Select Case iWaardeCelNaastTarget
                                Case 0, 1
                                    Target.Offset(0, 26).Font.ColorIndex = 3
                                Case 2, 5
                                    Target.Offset(0, 26).Font.ColorIndex = 6
                                                                Case 3, 4
                                    Target.Offset(0, 26).Font.ColorIndex = 4
                                    
                            End Select
                    Else
                        MsgBox "De waarde in kolom B is geen getal"
                    End If
         End Select
        End If
    End If
End Sub

Chetaahke dit is een exacte kopie van de code die ik van jou gekregen heb alleen heb ik hier de kolomnummer veranderd. maar ineens doet ie het niet meer goed. in de originele file wat ik van jou gekregen heb werkt ie nog steeds! op het moment dat ik de kolomnummer verander werkt ie daar ook niet!

Ik wilde ook ervoorzorgen dat niet de FontColor maar de InteriorColor verandert wordt en dan het getal vet gedrukt wordt maar dat gaat ook niet, als ik dat verander dan doet ie helemaal niks meer!!

Weet iemand daar een oplossing voor??

 

[Cheetahke]

ik heb nu het volgende probleem, onderstaande code gebruik ik om naar kolom "AC" te verwijzen vanuit colom "C" maar het werkt niet zoals het moet. Als ik in kolom "C" voor letter "H" kies en in kolom "AC" een getal invoer moet ik nog een keer in kolom "C" letter "H" kiezen om de kleur in kolom "AC" te veranderen. hij verandert de kleur niet automatisch na het invoeren van het getal in kolom "AC".

Logisch, hij registreert de verandering niet in kolom AC, enkel de verandering in kolom C wordt geregistreerd met onderstaande code. Als je met veranderingen op een heel werkblad wil werken, moet je volgende code weglaten, maar dan kun je niet meer met offset werken. Ik geef je een voorbeeldje met onderstaande code:
Je verandert in kolom C een waarde, dan springt hij naar kolom AC en verandert daar de ingestelde kleur, dan springt hij naar kolom BC en indien daar een getal staat, verandert hij ook daar de kleur, dan naar kolom CC, en daar heb dezelfde reactie, enz...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim sWaardeTarget As String
    Dim iWaardeCelNaastTarget
    
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        If Not IsEmpty(Target.Value) Then
        
            sWaardeTarget = CStr(Target.Value)
            Select Case sWaardeTarget
               
                Case "H"
                    
                    If IsNumeric(Target.Offset(0, 26).Value) Then
                        iWaardeCelNaastTarget = CInt(Target.Offset(0, 26).Value)
                               Select Case iWaardeCelNaastTarget
                                Case 0, 1
                                    Target.Offset(0, 26).Font.ColorIndex = 3
                                Case 2, 5
                                    Target.Offset(0, 26).Font.ColorIndex = 6
                                                                Case 3, 4
                                    Target.Offset(0, 26).Font.ColorIndex = 4
                                    
                            End Select
                    Else
                        MsgBox "De waarde in kolom B is geen getal"
                    End If
         End Select
        End If
    End If
End Sub

Chetaahke dit is een exacte kopie van de code die ik van jou gekregen heb alleen heb ik hier de kolomnummer veranderd. maar ineens doet ie het niet meer goed. in de originele file wat ik van jou gekregen heb werkt ie nog steeds! op het moment dat ik de kolomnummer verander werkt ie daar ook niet!


Ik wilde ook ervoorzorgen dat niet de FontColor maar de InteriorColor verandert wordt en dan het getal vet gedrukt wordt maar dat gaat ook niet, als ik dat verander dan doet ie helemaal niks meer!!

Weet iemand daar een oplossing voor??

Heb je je file eerst opgeslagen alvorens te testen? Enkel de code in VBA veranderen helpt niet echt, dat heb ik ook ondervonden. Soms moest ik zelfs even de excelfile afsluiten en terug opstarten om de code degelijk te laten werken.