Opgelost Cellen naast elkaar kleur geven met VBA

[Gielleke25]

Hallo iedereen,
Graag nog eens jullie hulp/kennis aub...

In mijn bijgevoegd bestand, heb ik het tabblad "Ranglijst - REEKS A" wanneer ik dit tabblad telkens opnieuw open doet wil ik dat Excel in de 3 tabellen telkens de persoon met bijhorende punten (p.s. die komen later nog ingevuld) in de gevel kleur geeft.
Ik heb zelf hiervoor de functie For Each next gebruikt en dit werkt prima voor de namen.
Echter wil ik graag ook de bijhorende punten in het zelfde kleur zien...
In mijn huidig bestand is dit dan cel C24, D24, G24 en J24

Wanneer de naam van de persoon wijzigt moeten de kleuren natuur ook meegaan opnieuw naar boven of onderen.

Alvast super bedankt voor jullie hulp!

 

[AHulpje]

Om in jouw programmeerstijl te blijven, deze regels op de juiste plaats tussenvoegen:

            zoeken1.Offset(0, 1).Interior.Color = RGB(255, 255, 102)
            zoeken1.Offset(0, 2).Interior.Color = RGB(255, 255, 102)

            zoeken2.Offset(0, 1).Interior.Color = RGB(255, 255, 102)

            zoeken3.Offset(0, 1).Interior.Color = RGB(255, 255, 102)

 

[Gielleke25]

AHulpje de code werkt perfect!
Had zelf niet gedacht dat dit zo eenvoudig ging zijn...
Kan ik de tekst "vet" ook hierop gebruiken? Dit had ik al in tussentijd gedaan terwijl u bezig was...
Want nu plaats hij ook nog steeds de naam in het "vet"
Super Bedankt!

Private Sub Worksheet_Activate()

    Dim zoeken1 As Range
    For Each zoeken1 In Range("B18:B52")
    
        If zoeken1.value = Range("L19").value Then
        zoeken1.Interior.Color = RGB(255, 255, 102)
        zoeken1.Offset(0, 1).Interior.Color = RGB(255, 255, 102)
        zoeken1.Offset(0, 2).Interior.Color = RGB(255, 255, 102)
        zoeken1.Font.FontStyle = "Bold"

        End If
    
    Next zoeken1
    
    
    
    Dim zoeken2 As Range
    For Each zoeken2 In Range("F18:F52")
    
        If zoeken2.value = Range("L19").value Then
        zoeken2.Interior.Color = RGB(255, 255, 102)
        zoeken2.Offset(0, 1).Interior.Color = RGB(255, 255, 102)
        zoeken2.Font.FontStyle = "Bold"


        End If
    
    Next zoeken2
    
    
    
    Dim zoeken3 As Range
    For Each zoeken3 In Range("I18:I52")
    
        If zoeken3.value = Range("L19").value Then
        zoeken3.Interior.Color = RGB(255, 255, 102)
        zoeken3.Offset(0, 1).Interior.Color = RGB(255, 255, 102)
        zoeken3.Font.FontStyle = "Bold"

        
        End If
    
    Next zoeken3

End Sub

 

[Gielleke25]

Heb het net zelf gevonden denk ik...

 

[Gielleke25]

Heb dit zo gedaan, en dit werkt...
Bedankt voor de hulp!

Private Sub Worksheet_Activate()

    Dim zoeken1 As Range
    For Each zoeken1 In Range("B18:B52")
    
        If zoeken1.value = Range("L19").value Then
        zoeken1.Interior.Color = RGB(255, 255, 102)
        zoeken1.Offset(0, 1).Interior.Color = RGB(255, 255, 102)
        zoeken1.Offset(0, 2).Interior.Color = RGB(255, 255, 102)
        zoeken1.Font.FontStyle = "Bold"
        zoeken1.Offset(0, 1).Font.FontStyle = "Bold"
        zoeken1.Offset(0, 2).Font.FontStyle = "Bold"

        End If
    
    Next zoeken1
    
    
    
    Dim zoeken2 As Range
    For Each zoeken2 In Range("F18:F52")
    
        If zoeken2.value = Range("L19").value Then
        zoeken2.Interior.Color = RGB(255, 255, 102)
        zoeken2.Offset(0, 1).Interior.Color = RGB(255, 255, 102)
        zoeken2.Font.FontStyle = "Bold"
        zoeken2.Offset(0, 1).Font.FontStyle = "Bold"


        End If
    
    Next zoeken2
    
    
    
    Dim zoeken3 As Range
    For Each zoeken3 In Range("I18:I52")
    
        If zoeken3.value = Range("L19").value Then
        zoeken3.Interior.Color = RGB(255, 255, 102)
        zoeken3.Offset(0, 1).Interior.Color = RGB(255, 255, 102)
        zoeken3.Font.FontStyle = "Bold"
        zoeken3.Offset(0, 1).Font.FontStyle = "Bold"

        
        End If
    
    Next zoeken3

End Sub

 

[AD1957]

Of korter.

For Each it In Range("B18:B52")
            If it.Value = Range("L19").Value Then
                it.Resize(, 3).Interior.Color = RGB(255, 255, 102)
                it.Resize(, 3).Font.FontStyle = "Bold"
            End If
    Next it
   
    For Each it In Range("F18:F52,I18:I52")
            If it.Value = Range("L19").Value Then
                it.Resize(, 2).Interior.Color = RGB(255, 255, 102)
                it.Resize(, 2).Font.FontStyle = "Bold"
            End If
    Next it

 

[emields]

Daar is toch helemaal geen vba voor nodig?

 

[Gielleke25]

Bedankt voor de toevoegingen!