Color Rows with Value in it, in all Columns, based on Color of Value in Dropdown List (dynamic)

[BlackArch]

Hello, I've got this kind of Planer and im stuck.
My Sheet has Columns A-BA. A & B are Times as you can see and D-BA are Relevant. Row 30 is always a Dropdown Menü which grabs values from a list in another worksheet. Those Values are Color Formatted. now i want the rows which i put a "#" in to take over the color of the value chosen in the dropdown menu. Visualized:

Quick n Dirty, I've written this:

Sub DienstplanFarbzuordnung()

'----------------------------------VARIABLEN----------------------------------'
'Montag
Dim AktuelleFarbeD
Dim AktuelleFarbeE
Dim AktuelleFarbeF
Dim AktuelleFarbeG
Dim AktuelleFarbeH
Dim AktuelleFarbeI
Dim AktuelleFarbeJ
Dim AktuelleFarbeK
Dim AktuelleFarbeL
Dim AktuelleFarbeM

'Dienstag
Dim AktuelleFarbeN
Dim AktuelleFarbeO
Dim AktuelleFarbeP
Dim AktuelleFarbeQ
Dim AktuelleFarbeR
Dim AktuelleFarbeS
Dim AktuelleFarbeT
Dim AktuelleFarbeU
Dim AktuelleFarbeV
Dim AktuelleFarbeW

'Mittwoch
Dim AktuelleFarbeX
Dim AktuelleFarbeY
Dim AktuelleFarbeZ
Dim AktuelleFarbeAA
Dim AktuelleFarbeAB
Dim AktuelleFarbeAC
Dim AktuelleFarbeAD
Dim AktuelleFarbeAE
Dim AktuelleFarbeAF
Dim AktuelleFarbeAG

'Donnerstag
Dim AktuelleFarbeAH
Dim AktuelleFarbeAI
Dim AktuelleFarbeAJ
Dim AktuelleFarbeAK
Dim AktuelleFarbeAL
Dim AktuelleFarbeAM
Dim AktuelleFarbeAN
Dim AktuelleFarbeAO
Dim AktuelleFarbeAP
Dim AktuelleFarbeAQ

'Freitag
Dim AktuelleFarbeAR
Dim AktuelleFarbeAS
Dim AktuelleFarbeAT
Dim AktuelleFarbeAV
Dim AktuelleFarbeAW
Dim AktuelleFarbeAX
Dim AktuelleFarbeAY
Dim AktuelleFarbeAZ
Dim AktuelleFarbeBA

'-----------------------------------------Definition MA zugewiesene Farbe--------------------------------------'

'Montag
AktuelleFarbeD = cells("D30").interior.Color
AktuelleFarbeE = cells("E30").interior.Color
AktuelleFarbeF = cells("F30").interior.Color
AktuelleFarbeG = cells("G30").interior.Color
AktuelleFarbeH = cells("H30").interior.Color
AktuelleFarbeI = cells("I30").interior.Color
AktuelleFarbeI = cells("J30").interior.Color
AktuelleFarbeI = cells("K30").interior.Color
AktuelleFarbeI = cells("L30").interior.Color
AktuelleFarbeI = cells("M30").interior.Color
'Dienstag
AktuelleFarbeN = cells("N30").interior.Color
AktuelleFarbeO = cells("O30").interior.Color
AktuelleFarbeP = cells("P30").interior.Color
AktuelleFarbeQ = cells("Q30").interior.Color
AktuelleFarbeR = cells("R30").interior.Color
AktuelleFarbeS = cells("S30").interior.Color
AktuelleFarbeT = cells("T30").interior.Color
AktuelleFarbeU = cells("U30").interior.Color
AktuelleFarbeV = cells("V30").interior.Color
AktuelleFarbeW = cells("W30").interior.Color
'Mittwoch
AktuelleFarbeX = cells("X30").interior.Color
AktuelleFarbeY = cells("Y30").interior.Color
AktuelleFarbeZ = cells("Z30").interior.Color
AktuelleFarbeAA = cells("AA30").interior.Color
AktuelleFarbeAB = cells("AB30").interior.Color
AktuelleFarbeAC = cells("AC30").interior.Color
AktuelleFarbeAD = cells("AD30").interior.Color
AktuelleFarbeAE = cells("AE30").interior.Color
AktuelleFarbeAF = cells("AF30").interior.Color
AktuelleFarbeAG = cells("AG30").interior.Color
'Donnerstag
AktuelleFarbeAH = cells("AH30").interior.Color
AktuelleFarbeAI = cells("AI30").interior.Color
AktuelleFarbeAJ = cells("AJ30").interior.Color
AktuelleFarbeAK = cells("AK30").interior.Color
AktuelleFarbeAL = cells("AL30").interior.Color
AktuelleFarbeAM = cells("AM30").interior.Color
AktuelleFarbeAN = cells("AN30").interior.Color
AktuelleFarbeAO = cells("AO30").interior.Color
AktuelleFarbeAP = cells("AP30").interior.Color
AktuelleFarbeAQ = cells("AQ30").interior.Color
'Freitag
AktuelleFarbeAR = cells("AR30").interior.Color
AktuelleFarbeAS = cells("AS30").interior.Color
AktuelleFarbeAT = cells("AT30").interior.Color
AktuelleFarbeAV = cells("AV30").interior.Color
AktuelleFarbeAW = cells("AW30").interior.Color
AktuelleFarbeAX = cells("AX30").interior.Color
AktuelleFarbeAY = cells("AY30").interior.Color
AktuelleFarbeAZ = cells("AZ30").interior.Color
AktuelleFarbeBA = cells("BA30").interior.Color

'--------------------------------------Montag-------------------------------------------------'

' Montag1.1
For Each InStr(1,Worksheets("Dienstplan").Range("D5:D28").Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeD
' Montag1.2
For Each InStr(1,Worksheets("Dienstplan").Range("E5:E28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeE
' Montag1.3
For Each InStr(1,Worksheets("Dienstplan").Range("F5:F28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeF
' Montag1.4
For Each InStr(1,Worksheets("Dienstplan").Range("G5:G28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeG
' Montag1.5
For Each InStr(1,Worksheets("Dienstplan").Range("H5:H28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeH
' Montag1.6
For Each InStr(1,Worksheets("Dienstplan").Range("I5:I28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeI
' Montag1.7
For Each InStr(1,Worksheets("Dienstplan").Range("J5:J28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeJ
' Montag1.8
For Each InStr(1,Worksheets("Dienstplan").Range("K5:K28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeK
' Montag1.9
For Each InStr(1,Worksheets("Dienstplan").Range("L5:L28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeL
' Montag1.10
For Each InStr(1,Worksheets("Dienstplan").Range("M5:M28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeM

'------------------------------------------Dienstag--------------------------------------'   
   
' Dienstag1.1
For Each InStr(1,Worksheets("Dienstplan").Range("N5:N28").Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeN
' Dienstag1.2
For Each InStr(1,Worksheets("Dienstplan").Range("O5:O28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeO
' Dienstag1.3
For Each InStr(1,Worksheets("Dienstplan").Range("P5:P28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeP
' Dienstag1.4
For Each InStr(1,Worksheets("Dienstplan").Range("Q5:Q28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeQ
' Dienstag1.5
For Each InStr(1,Worksheets("Dienstplan").Range("R5:R28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeR
' Dienstag1.6
For Each InStr(1,Worksheets("Dienstplan").Range("S5:S28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeS
' Dienstag1.7
For Each InStr(1,Worksheets("Dienstplan").Range("T5:T28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeT
' Dienstag1.8
For Each InStr(1,Worksheets("Dienstplan").Range("U5:U28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeU
' Dienstag1.9
For Each InStr(1,Worksheets("Dienstplan").Range("V5:V28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeV
' Dienstag1.10
For Each InStr(1,Worksheets("Dienstplan").Range("W5:W28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeW
   
'------------------------------------------Mittwoch--------------------------------------'   

' Mittwoch1.1
For Each InStr(1,Worksheets("Dienstplan").Range("X5:X28").Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeX
' Mittwoch1.2
For Each InStr(1,Worksheets("Dienstplan").Range("Y5:Y28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeY
' Mittwoch1.3
For Each InStr(1,Worksheets("Dienstplan").Range("Z5:Z28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeZ
' Mittwoch1.4
For Each InStr(1,Worksheets("Dienstplan").Range("AA5:AA28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAA
' Mittwoch1.5
For Each InStr(1,Worksheets("Dienstplan").Range("AB5:AB28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAB
' Mittwoch1.6
For Each InStr(1,Worksheets("Dienstplan").Range("AC5:AC28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAC
' Mittwoch1.7
For Each InStr(1,Worksheets("Dienstplan").Range("AD5:AD28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAD
' Mittwoch1.8
For Each InStr(1,Worksheets("Dienstplan").Range("AE5:AE28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAE
' Mittwoch1.9
For Each InStr(1,Worksheets("Dienstplan").Range("AF5:AF28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAF
' Mittwoch1.10
For Each InStr(1,Worksheets("Dienstplan").Range("AG5:AG28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAG

'------------------------------------------Donnerstag--------------------------------------'   

' Donnerstag1.1
For Each InStr(1,Worksheets("Dienstplan").Range("AH5:AH28").Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAH
' Donnerstag1.2
For Each InStr(1,Worksheets("Dienstplan").Range("AI5:AI28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAI
' Donnerstag1.3
For Each InStr(1,Worksheets("Dienstplan").Range("AJ5:AJ28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAJ
' Donnerstag1.4
For Each InStr(1,Worksheets("Dienstplan").Range("AK5:AK28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAK
' Donnerstag1.5
For Each InStr(1,Worksheets("Dienstplan").Range("AL5:AL28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAL
' Donnerstag1.6
For Each InStr(1,Worksheets("Dienstplan").Range("AM5:AM28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAM
' Donnerstag1.7
For Each InStr(1,Worksheets("Dienstplan").Range("AN5:AN28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAN
' Donnerstag1.8
For Each InStr(1,Worksheets("Dienstplan").Range("AO5:AO28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAO
' Donnerstag1.9
For Each InStr(1,Worksheets("Dienstplan").Range("AP5:AP28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAP
' Donnerstag1.10
For Each InStr(1,Worksheets("Dienstplan").Range("AQ5:AQ28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAQ

'----------------------------------------Freitag-----------------------------------------'

' Freitag1.1
For Each InStr(1,Worksheets("Dienstplan").Range("AR5:AR28").Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAR
' Freitag1.2
For Each InStr(1,Worksheets("Dienstplan").Range("AS5:AS28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAS
' Freitag1.3
For Each InStr(1,Worksheets("Dienstplan").Range("AT5:AT28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAT
' Freitag1.4
For Each InStr(1,Worksheets("Dienstplan").Range("AU5:AU28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAU
' Freitag1.5
For Each InStr(1,Worksheets("Dienstplan").Range("AV5:AV28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAV
' Freitag1.6
For Each InStr(1,Worksheets("Dienstplan").Range("AW5:AW28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAW
' Freitag1.7
For Each InStr(1,Worksheets("Dienstplan").Range("AX5:AX28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAX
' Freitag1.8
For Each InStr(1,Worksheets("Dienstplan").Range("AY5:AY28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAY
' Freitag1.9
For Each InStr(1,Worksheets("Dienstplan").Range("AZ5:AZ28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeAZ
' Freitag1.10
For Each InStr(1,Worksheets("Dienstplan").Range("BA5:BA28".Value, "#", vbTextCompare) = 1
    interior.Color = AktuelleFarbeBA

Does InStr even Work in a Loop ? I know theres some syntax missing. Im thinking of a more elegant way, as in dynamic to solve this.

ColumnName = Split(ActiveCell.Address(1, 1), "$")(1)

Got me the ColumnName of the ActiveCell. Which is kind of what i want. But i dont seem to be able to use it with range so i can grab the Color of

Farbfeld = ColumnName & ":30"

Ausgabe = Farbfeld & ":30".DisplayFormat.Interior.Color

Im kind of Stuck.
I've read about The displayformat interior color not even working with formatted cells.. is all this even possible with vba?
If it is not working, i would have to color each :30 Column instead of the Values in the Dropdown List.

Anyone has an idea how to solve this?

Thanks in Advance

BlackArch

 

[BlackArch]

For Calling if a "#" is set - before asking the color of :30 - i've though about this loop

For Each cell in Range1 If Not IsEmpty(cell) Then

 

[BlackArch]

View attachment 51065

Each "#" Set in Column D is supposed to turn Blue (Value 1 Formatting)

 

[Fluff]

How are the cells in row 30 getting their colour?

 

[BlackArch]

How are the cells in row 30 getting their colour?

conditional formatting

 

[Fluff]

In that case why not use conditionl formatting for the other rows, with

=AND(D$30=1,D5="#")