namen kleur geven wanneer niet wordt voldaan aan bepaalde voorwaarde

[VenA]

Misschien moet je het bestandje en met name de code nogmaals bekijken. Dan zie je ook dat het voorbeeldbestand dat je geplaatst hebt weer niet volledig was. Naam02 spreekt geen Fins en had je ook als rood moeten markeren.

 

[Gerard2348]

Ha VenA,

Je hebt helemaal gelijk. Excuses voor de verwarring.

 

[Gerard2348]

Ondanks de oplossing van Harry (HSV) waarmee ik overigens blij mee bent had ik de oplossing toch liever via een VBA code. Heb de code van VenA veelvuldig, na aanbeveling in #21, bekeken om te kijken wat er moet worden veranderd om tot het gewenste resultaat te komen. Maar helaas...... Ik kom er niet uit.
Wellicht heeft iemand de oplossing of kan mij verder op weg helpen.

Groet Geer

 

[HSV]

Met Vba,

 

[Gerard2348]

Ha Harry,

Heb net het bestand bekeken en getest. En voor zover ik het kan zien ziet het er hartstikke goed uit. Mijn hartelijke dank hiervoor. :thumb::d
Ben er zeer blij mee.

MvG
Geer

 

[Gerard2348]

Ha Harry,

Jouw code werkt naar tevredenheid. Maar ik heb toch nog een vraag. je hebt mij ooit eens geholpen met het kleuren van namen wanneer er niet een exacte overeenkomst is met de te controlerende namen met het volgende stukje code;

With Sheets("Blad3") 'wordt blad("Bijzonderheden") 
        sn = Split(Join(Application.Transpose(.Range("D2:D" & .Cells(Rows.Count, 4).End(xlUp).Row)), ";"), ";")
    End With
    For i = LBound(sn) To UBound(sn)
     Set c = Blad2.Range("B2:F50").Find(sn(i), , , xlPart)
        If Not c Is Nothing Then

Ik heb geprobeerd om deze code aan te passen en te integreren maar kom er niet uit.

 

[HSV]

Gerard, laat eens een bestandje zien waarin een naam niet overeenkomt, maar wel gevonden dient te worden.

 

[Gerard2348]

Als we naar Blok 01 en Blok 02 kijken dan moeten de namen die nu in blok 01 kleuren ook in blok 02 kleuren dit allemaal volgens de voorwaarde op het blad "Bijzonderheden").

Bekijk bijlage namen kleuren voorwaarde anders uitgelegd hsv (4).xlsb

mvg

Geer

 

[HSV]

Probeer dit eens.

Sub hsv()
Dim sv, area As Range, i As Long, ii As Long, iii As Long, j As Long, jj As Long, y As Long
sv = Sheets("bijzonderheden").Cells(3, 1).CurrentRegion
For Each area In Blad1.UsedRange.SpecialCells(2).Areas
 For i = 1 To area.Rows.Count
   For ii = 1 To UBound(sv)
[COLOR=#0000ff]      If InStr(area(i, 2), sv(ii, 2)) Then[/COLOR]
        For iii = 1 To area.Rows.Count
         For j = 3 To UBound(sv, 2)
          If area(iii, 1) = sv(2, j) And LCase(sv(ii, j)) = "x" Then
            y = y + 1
            Exit For
            End If
         Next j
        Next iii
      area(i, 2).Font.Color = IIf(y = area.Rows.Count, vbBlack, vbRed)
    End If
    y = 0
    Next ii
 Next i
 Next area
End Sub

 

[Gerard2348]

Ha Harry,

Hartelijk dank. Ik ga het de komende week uitvoerig testen.

Mvg