Kolom toewijzen kleuren

[Roma]

beste,
In onderstaande formule wordt kolom B toegewezen om in een ander tabblad een kleur toe te wijzen.
Graag wil ik ook kolom D toewijzen.
Helaas lukt mij dat niet.
Weet iemand hier de oplossing voor?
Bij voorbaat dank

Option Explicit
Public trgValue
'Namen kleuren
Function SelectColor(Optional lngInitialColor As Long = 16777215) As Long
Dim lngResult As Long, lngO As Long, intR As Long, intG As Long, intB As Long, c As Range
Dim firstaddress As String
Dim Sh As Worksheet
lngResult = xlNone
If Not ActiveWorkbook Is Nothing Then
    lngO = ActiveWorkbook.Colors(1)
    intR = lngInitialColor And 255
    intG = lngInitialColor \ 256 And 255
    intB = lngInitialColor \ 256 ^ 2 And 255
    If Application.Dialogs(xlDialogEditColor).Show(1, intR, intG, intB) = True Then
        lngResult = ActiveWorkbook.Colors(1)
        ActiveWorkbook.Colors(1) = lngO
    End If
End If
SelectColor = lngResult
For Each Sh In Sheets
If Not Sh.Name = "Diensten" Then   '(namen org) naam tabblad

  With Sh.Columns(2)

     Set c = .Find(trgValue, , xlValues, xlWhole)
       If Not c Is Nothing Then
                firstaddress = c.Address
            c.Interior.Color = lngResult
       Do
                      Set c = .FindNext(c)
           c.Interior.Color = lngResult
        Loop While Not c Is Nothing And c.Address <> firstaddress
      End If
    End With
   
    End If
    Next Sh
End Function

 

[OctaFish]

Ik snap niet waarom je een kleur laat kiezen (SelectColor), en die vervolgens niet gebruikt, maar daar zal je een reden voor hebben. Ik heb je code zo aangepast:

Dim rng As Range
    For Each Sh In Sheets
        If Not Sh.Name = "Diensten" Then   '(namen org) naam tabblad
            Set rng = Range("B:B,D:D")
            rng.Interior.Color = SelectColor
            Range("A1").Select
        End If
    Next Sh

Scheelt ook enorm in de snelheid, want jouw code loopt heel wat celletjes door, en da's niet echt snel...

 

[Roma]

Beste Michel,
Bedankt voor je reactie.
Misschien heb ik het niet goed uitgelegd.
Ik heb een tabblad diensten en daarna nog een aantal tabbladen met de maanden.
In het tabblad diensten kan ik nu de naam een kleur geven en deze komen terug in de tabbladen van de maanden.
Graag wil een extra kolom toevoegen (D) om deze ook mee te laten kleuren.

Ik heb een klein voorbeeldje toegevoegd