Dubbele waarde cell kleur geven.

[Dokman]

Hallo,

Ik heb en script van internet gehaald. Die 2 kolommen met elkaar vergelijkt.
In dit geval Kolom, A en H. zitten er dubbele waarde, dan maakt hij de getallen rood. Maar ik heb liever dat hij de Cell rood (Of andere kleur) maakt.

Maar deze script moet ik 5x laten lopen, want ik heb meerdere kolommen die met elkaar vergeleken moet worden.

A & H -> Rood
B & M -> Paars
C & R -> Geel
D & W -> groen
E - AB -> Blauw

Nu weet ik dat ik dat gewoon kan doen in Excel in plaats van en script. Maar de getallen worden ingelezen via en ander excel bestand.
en dan onthoud excel met cellen niet meer en maakt er wat anders van.

Zou iemand kunnen kijken voor mijn.

Sub Validation()
    Dim FirstRng, SecondRng As Range
    Set FirstRng = Blad1.Range("A:A")
    Set SecondRng = Blad1.Range("H:H")
  
    If CheckForDups(FirstRng, SecondRng) = True Then
        MsgBox "There were duplicates found and they have been highlighted"
        Exit Sub
    End If
End Sub

Function CheckForDups(ByVal CycleRng As Range, ByVal CheckRng As Range) As Boolean
    Dim cell As Range
    Dim Duplicate As Range
    For Each cell In CycleRng.Cells
        If cell.Value = "" Then Exit For
        Set Duplicate = CheckRng.Find(cell.Value)
        If Not Duplicate Is Nothing Then
            'Duplicate found
            cell.Font.Color = vbRed
            Duplicate.Font.Color = vbRed
            CheckForDups = True
        End If
    Next cell
End Function

 

[edmoor]

Je kan de Sub Validation in een loop van 1 t/m 5 laten lopen waarbij je afhankelijk van dat getal de juiste range opgeeft.

 

[Dokman]

Dat snap ik. Wou ik ook doen als er geen andere oplossing is.
Alleen nu wordt mijn tekst rood. Graag zou ik de sell rood hebben en de tekst zwart.

cell.Font.Color = vbYellow
Duplicate.Font.Color = vbYellow

Wat kan ik dat het beste veranderen.

 

[edmoor]

Cell.Font.Color wijzigt de tekst kleur.
Cell.Interior.Color wijzigt de cel kleur.

 

[AHulpje]

Sub Validation()
    With Blad1
        CheckForDups .Range("A:A"), .Range("H:H"), vbRed
        CheckForDups .Range("B:B"), .Range("M:M"), vbMagenta
        CheckForDups .Range("C:C"), .Range("R:R"), vbYellow
        CheckForDups .Range("D:D"), .Range("W:W"), vbGreen
        CheckForDups .Range("E:E"), .Range("AB:AB"), vbBlue
    End With
End Sub

Function CheckForDups(ByVal CycleRng As Range, ByVal CheckRng As Range, kleur) As Boolean
    Dim cell As Range
    Dim Duplicate As Range
    For Each cell In CycleRng.Cells
        If cell.Value = "" Then Exit For
        Set Duplicate = CheckRng.Find(cell.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not Duplicate Is Nothing Then
            'Duplicate found
            cell.Interior.Color = kleur
            Duplicate.Interior.Color = kleur
            CheckForDups = True
        End If
    Next cell
    If CheckForDups Then MsgBox "There were duplicates found and they have been highlighted"
End Function

 

[roeljongman]

toch ook even voorbeeldje zonder VBA.

Dubbele waarden op 2 kolommen kun je ook gewoon met VO (voorwaardelijke opmaak) doen

 

[Dokman]

toch ook even voorbeeldje zonder VBA.

Dubbele waarden op 2 kolommen kun je ook gewoon met VO (voorwaardelijke opmaak) doen

Ja dat weet ik maar omdat ik speciaal plak in HTML formaat gat die VO sommige cellen overslaan waar wel waarders in zitten.