aanpassen van een bestaande code

[Gerard2348]

Beste experts,
Bijgaande code is ooit tot stand gekomen door een aantal knappe koppen op dit forum. Ik gebruik deze code elke dag met plezier. Deze code kijkt of de personen in blad (“namen”) voorkomen en kleurt deze dan in blad(“Blad”1”) . Als er een toevoeging op (“Blad1”) achter de naam staat dan wordt deze naam gekleurd wat goed is. Alleen is er een kleine behoefte bijgekomen. Wanneer er op blad (“namen”) een toevoeging achter de naam staat dan wordt deze niet op Blad (“Blad1”) gekleurd. Is het mogelijk om de code aan te passen dat deze dan ook wordt gekleurd.

 

[edmoor]

Probeer het eens zo:

Sub Aanwezig()
    Application.ScreenUpdating = False
    Call kleur_uit
   
    With Sheets("namen")
        sn = Split(Join(Application.Transpose(.Range("C1:C150" & .Cells(Rows.Count, 4).End(xlUp).Row)), ";"), ";")
    End With
    
    For I = LBound(sn) To UBound(sn)
        If sn(I) <> "" And Len(sn(I)) > 4 Then Zoek = Left(sn(I), Len(sn(I)) - 4)
        Set c = ActiveSheet.Range("B5:B120").Find(Zoek, , , xlPart)
        If Not c Is Nothing Then
            With c.Interior
                .ColorIndex = 19
            End With
            
            With c.Font
                .Bold = True
                .ColorIndex = 5
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[Gerard2348]

ha edmoor,

heb het getest en ik denk dat is wat ik zoek.
mijn hartelijke dank :thumb: