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

B

BlackArch

New Member
Joined
Nov 12, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
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:

Screenshot 2021-11-10 140740.png


Quick n Dirty, I've written this:

VBA Code: 
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.

VBA Code: 
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
VBA Code: 
Farbfeld = ColumnName & ":30"
VBA Code: 
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
 
Last edited by a moderator:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
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
Click to expand...
 
Upvote 0
How are the cells in row 30 getting their colour?
 
Upvote 0
In that case why not use conditionl formatting for the other rows, with
Excel Formula: 
=AND(D$30=1,D5="#")
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
VBA -highlighting rows when a condition is met
Replies
2
Views
162
Evie76
E
C
  • Question
Finding any two values in each cell text in a column of cells with both values as one Textbox1 variable
2
Replies
10
Views
217
chazrab
C
M
  • Solved
Assistance Needed with Excel VBA Code for Color Formatting
2
Replies
10
Views
764
RudRud
R
Y
  • Solved
Highlighting selected words in a column.
Replies
6
Views
131
Akuini
Akuini
R
  • Question
dates VBA
Replies
5
Views
307
Micron
M

Forum statistics

Threads
1,214,649
Messages
6,120,730
Members
448,987
Latest member
marion_davis

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top