Change cell value based on the color of another cell

Woodpusher147

Board Regular
Joined
Oct 6, 2021
Messages
69
Office Version
  1. 365
Platform
  1. Windows
Hello
I hope someone can help with a (in my not super excel mind) very complicated issue.
1633520453103.png


I have the above spreadsheet to track performance which has 11 columns and however many staff there are as rows.
The sheet has conditional formating to shade each cell based on score, that's all done ok.
I also have data validation as Bedroom does not score in columns 4,5,6,7,8 - Upstairs & Downstairs do not score in 9 or 10

However, I now need to have an overall score by using the following Key
RED =0
AMBER=1
GREEN=3
YELLOW=5
The other complication is that columns 1,2,3 and 4 will score 4 times more than all other columns but I guess I can do this by having the formula/code populate hidden cell which I can then simply refer to this x4 for the cells in rows 1,2,3,4

Ive looked at an old thread which is titled "Changing cell value based on the color of another cell" and has an interesting
User Defined Function in VBA by Joe4. This could work as I dont want the code to run on all the sheet but I really need help

Rick Rothstein and sheetspread also commented and helped


I hope you can help as my head is now hurting :)


Thank you for any replies

Simon
1633519851369.png
 
Just as an FYI, it's now possible to get the format of a conditionally formatted cell easier than the macro shown above. Here's an example:

 
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Good evening,

Basically, the Key for the conditional formatting is:
Red > Below acceptable standards.
less than 85%
less than 70%
less than 5
less than 65%
less than 20%
less than 75%
less than 20%
less than 20%
less than 35%
less than 50%
less than 80%
COLUMN
1
2
3
4
5
6
7
8
9
10
11
Amber > Improvement needed to meet acceptable standards.
85% -99%
70-74%
5+
65% - 69%
20% - 23%
75% - 79%
21% - 25%
21% - 25% (20% - 21%
35% - 39%
50% - 64%
80% - 84% (75% - 81%
Green > Meets acceptable standards.
100%-104%
75-79%
10+
70% - 74%
24% - 29%
80 - 84%
26% - 30% (23% - 31%
26% - 30%
40% - 59%
65% - 74%
85% - 89%
Gold> Outstanding
Over 105%
80% and over
15+
75% and over
30% and over
85% and over
30% and over
30% and over
60% and over
75% and over
90% and over

Looking at that, I noticed that there are some inconsistencies in that chart. For example, under column 11 under Amber, you have 80% - 84% (75% - 81%) which from an outsider's point of view means 75% - 84%. But this doesn't make sense because for Red, you have <80%.

But anyway, I appreciate the table summary. However, I just looked at the XL2BB spreadsheet capture that you provided and deduced that this is the actual rules that are currently applied in your sheet.

Actual Summary Table (from Spreadsheet capture)
Original.PNG


This only has two inconsistencies. I show the change I made to both of them to make it consistent (in light blue) in the table below.

Corrected Actual Summary Table (from Spreadsheet capture)
Correction.PNG



Furthermore, I have written the following VBA code which you can use to generate these rules entirely from scratch in what I believe is a very organized and efficient way. So that if these need to be changed in the future, it will be easy to change!


Notes (if you want to try this code out):
  • First and foremost, of course make a copy of your Excel Workbook before you try this code out.

  • I have observed the specific shades of RGB that the cells are in your sheet (by observing the formatting conditions portion of your spreadsheet capture from XL2BB) and have assigned them to the names of the colors you listed. (Please change those to the desired colors you want, since I am seeing that in your summary table above, you use different colors than the colors of the cells in your XL2BB spreadsheet capture.
    VBA Code:
    red = RGB(255, 0, 0) 'Red
    amber = RGB(255, 230, 153) 'Amber
    green = RGB(0, 176, 80) 'Green
    gold = RGB(255, 255, 0) 'Gold
    fontColorForRedCells = RGB(255, 255, 255) 'White

  • You need to input the start row and lastRow in the code (just change the 6 and 1000 to whatever they need to be, respectively). If the first conditional formatting row indeed starts at row 6 (as is in your XL2BB spreadsheet capture), then all you need to do is change the 1000. But I was assuming that this was a reasonable upperbound. If not, just increase it.
    VBA Code:
    firstRow = 6
    lastRow = 1000

  • If Column 1 = Column F (and therefore, Column 11 = Column P), then you don't need to change anything in the following line. (But obviously if the column letters change, just replace F with the new start (left-most) column letter and "P" with the last one.)
    VBA Code:
    Call DeleteFormatConditions("F", "P", firstRow, lastRow)

  • You will then see 11 (nearly equivalent) blocks of code. The first is the following. Clearly you can see that the numbers in this code block correspond to the numbers in the " Corrected Actual Summary Table (from Spreadsheet capture).
    VBA Code:
    columnLetter = "F"
    Call LessThan(85, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
    Call Between(85, 99, columnLetter, firstRow, lastRow, amber)
    Call Between(100, 105, columnLetter, firstRow, lastRow, green)
    Call GreaterThan(105, columnLetter, firstRow, lastRow, gold)

  • So all you have to do is change those 6 numbers for each of the columns and then run the following macro/sub with the spreadsheet in view. If you do, it will delete all previous conditional formatting from F6:P1000 (in this example) and then do all of the conditional formatting!
    VBA Code:
    Sub Set_Conditional_Formatting()
    • See the list of conditional formatting in my spreadsheet capture. You will see that there are only 44 conditional formatting rules in mine, while there are 301 in yours! (That must have been very hard to do!) But the two (as other and you can verify) do the same thing.

  • I also payed attention that you want the font for the red cells to be white. (You can see that in the code, but also in my spreadsheet capture.)

[The actual code to put in a module in your Workbook.] -- For generating the conditional formatting rules for you.
VBA Code:
Sub Set_Conditional_Formatting()
Dim firstRow&, lastRow&, columnLetter$, red, amber, green, gold

red = RGB(255, 0, 0)  'Red
amber = RGB(255, 230, 153) 'Amber
green = RGB(0, 176, 80) 'Green
gold = RGB(255, 255, 0) 'Gold
fontColorForRedCells = RGB(255, 255, 255) 'White

firstRow = 6
lastRow = 1000


Call DeleteFormatConditions("F", "P", firstRow, lastRow)

columnLetter = "F"
Call LessThan(85, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(85, 99, columnLetter, firstRow, lastRow, amber)
Call Between(100, 105, columnLetter, firstRow, lastRow, green)
Call GreaterThan(105, columnLetter, firstRow, lastRow, gold)

columnLetter = "G"
Call LessThan(70, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(70, 74, columnLetter, firstRow, lastRow, amber)
Call Between(75, 79, columnLetter, firstRow, lastRow, green)
Call GreaterThan(79, columnLetter, firstRow, lastRow, gold)

columnLetter = "H"
Call LessThan(5, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(5, 9, columnLetter, firstRow, lastRow, amber)
Call Between(10, 14, columnLetter, firstRow, lastRow, green)
Call GreaterThan(14, columnLetter, firstRow, lastRow, gold)

columnLetter = "I"
Call LessThan(58, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(58, 64, columnLetter, firstRow, lastRow, amber)
Call Between(65, 75, columnLetter, firstRow, lastRow, green)
Call GreaterThan(75, columnLetter, firstRow, lastRow, gold)

columnLetter = "J"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 23, columnLetter, firstRow, lastRow, amber)
Call Between(24, 29, columnLetter, firstRow, lastRow, green)
Call GreaterThan(29, columnLetter, firstRow, lastRow, gold)

columnLetter = "K"
Call LessThan(70, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(70, 75, columnLetter, firstRow, lastRow, amber)
Call Between(76, 84, columnLetter, firstRow, lastRow, green)
Call GreaterThan(84, columnLetter, firstRow, lastRow, gold)

columnLetter = "L"
Call LessThan(18, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(18, 22, columnLetter, firstRow, lastRow, amber)
Call Between(23, 31, columnLetter, firstRow, lastRow, green)
Call GreaterThan(31, columnLetter, firstRow, lastRow, gold)

columnLetter = "M"
Call LessThan(25, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(25, 35, columnLetter, firstRow, lastRow, amber)
Call Between(36, 51, columnLetter, firstRow, lastRow, green)
Call GreaterThan(51, columnLetter, firstRow, lastRow, gold)

columnLetter = "N"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 21, columnLetter, firstRow, lastRow, amber)
Call Between(22, 33, columnLetter, firstRow, lastRow, green)
Call GreaterThan(33, columnLetter, firstRow, lastRow, gold)

columnLetter = "O"
Call LessThan(35, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(35, 43, columnLetter, firstRow, lastRow, amber)
Call Between(44, 49, columnLetter, firstRow, lastRow, green)
Call GreaterThan(49, columnLetter, firstRow, lastRow, gold)

columnLetter = "P"
Call LessThan(75, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(75, 81, columnLetter, firstRow, lastRow, amber)
Call Between(82, 88, columnLetter, firstRow, lastRow, green)
Call GreaterThan(88, columnLetter, firstRow, lastRow, gold)

End Sub

Sub DeleteFormatConditions(columnLetter1 As String, columnLetter2 As String, firstRow As Long, lastRow As Long)
Range(columnLetter1 & firstRow & ":" & columnLetter2 & lastRow).FormatConditions.Delete
End Sub

Sub LessThan(num As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:=1, Formula2:=num - 1)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub

Sub GreaterThan(num As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:=num)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub

Sub Between(num1 As Variant, num2 As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:=num1, Formula2:=num2)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub


Change cell value based on the color of another cell.xlsb
DEFGHIJKLMNOPQ
41234567891011
5n/a85%80%55%20%70%15%25%35%40%85%POINTS
6Upstairs1854503330
7Bedroom1017025545041
8Downstairs457468
9Upstairs11072728
10Bedroom10773828
11Downstairs2579916
12Upstairs10780104552
13Bedroom84114515
14Downstairs851524
15Upstairs991416
16Bedroom10012
17Downstairs10512
18Upstairs10620
19Bedroom0
Sheet2
Cell Formulas
RangeFormula
Q6:Q19Q6=SUMPRODUCT(CFV(F6:P6),IF(D6="Bedroom",{4,4,4,0,0,0,0,0,1,1,1},{4,4,4,4,1,1,1,1,0,0,1}))
Cells with Conditional Formatting
CellConditionCell FormatStop If True
F6:F1000Cell Valuebetween 1 and 84textNO
F6:F1000Cell Valuebetween 85 and 99textNO
F6:F1000Cell Valuebetween 100 and 105textNO
F6:F1000Cell Value>105textNO
G6:G1000Cell Valuebetween 1 and 69textNO
G6:G1000Cell Valuebetween 70 and 74textNO
G6:G1000Cell Valuebetween 75 and 79textNO
G6:G1000Cell Value>79textNO
H6:H1000Cell Valuebetween 1 and 4textNO
H6:H1000Cell Valuebetween 5 and 9textNO
H6:H1000Cell Valuebetween 10 and 14textNO
H6:H1000Cell Value>14textNO
I6:I1000Cell Valuebetween 1 and 57textNO
I6:I1000Cell Valuebetween 58 and 64textNO
I6:I1000Cell Valuebetween 65 and 75textNO
I6:I1000Cell Value>75textNO
J6:J1000Cell Valuebetween 1 and 19textNO
J6:J1000Cell Valuebetween 20 and 23textNO
J6:J1000Cell Valuebetween 24 and 29textNO
J6:J1000Cell Value>29textNO
K6:K1000Cell Valuebetween 1 and 69textNO
K6:K1000Cell Valuebetween 70 and 75textNO
K6:K1000Cell Valuebetween 76 and 84textNO
K6:K1000Cell Value>84textNO
L6:L1000Cell Valuebetween 1 and 17textNO
L6:L1000Cell Valuebetween 18 and 22textNO
L6:L1000Cell Valuebetween 23 and 31textNO
L6:L1000Cell Value>31textNO
M6:M1000Cell Valuebetween 1 and 24textNO
M6:M1000Cell Valuebetween 25 and 35textNO
M6:M1000Cell Valuebetween 36 and 51textNO
M6:M1000Cell Value>51textNO
N6:N1000Cell Valuebetween 1 and 19textNO
N6:N1000Cell Valuebetween 20 and 21textNO
N6:N1000Cell Valuebetween 22 and 33textNO
N6:N1000Cell Value>33textNO
O6:O1000Cell Valuebetween 1 and 34textNO
O6:O1000Cell Valuebetween 35 and 43textNO
O6:O1000Cell Valuebetween 44 and 49textNO
O6:O1000Cell Value>49textNO
P6:P1000Cell Valuebetween 1 and 74textNO
P6:P1000Cell Valuebetween 75 and 81textNO
P6:P1000Cell Valuebetween 82 and 88textNO
P6:P1000Cell Value>88textNO


The above total points calculations are a result from the following code. (I integrated @Eric W's code that he provided into the previous code.)

So the code for the user defined function CFV() is below.
  • You can put this in a separate module from the other code (the code to regenerate/update formatting conditions for the points system).

  • You don't have to run the following code. Just put the following formula in Cell Q6 and fill it down as many rows as needed (since you said it's correct):
    Excel Formula:
    =SUMPRODUCT(CFV(F6:P6),IF(D6="Bedroom",{4,4,4,0,0,0,0,0,1,1,1},{4,4,4,4,1,1,1,1,0,0,1}))

  • But you need to change RGB shades
    VBA Code:
    Select Case DFColor(R)
            Case "RGB(255,0,0)" '3 'Red
                currentVal = 0
    
            Case "RGB(255,230,153)" '44 Amber
                currentVal = 1
    
            Case "RGB(0,176,80)" '4 Green
                currentVal = 3
    
            Case "RGB(255,255,0)" '6 Yellow

    to match those in the conditional formatting generation code:
    VBA Code:
    Sub Set_Conditional_Formatting()Dim firstRow&, lastRow&, columnLetter$, red, amber, green, gold
    
    red = RGB(255, 0, 0)  'Red
    amber = RGB(255, 230, 153) 'Amber
    green = RGB(0, 176, 80) 'Green
    gold = RGB(255, 255, 0) 'Gold

    for this to work. (Currently they DO match. So if you use the code to regenerate the formatting conditions, everything should work.)

[The actual code to put in a module in your Workbook.] -- For the user-defined function to do the number of points calculations.
VBA Code:
Sub Test__CFV()
'MsgBox ConditionalColor(ActiveCell)
MsgBox CFV(ActiveCell)(1)
End Sub
Function CFV(rng As Range)
Application.Volatile

ReDim cf_Cells(1 To rng.Columns.Count)
Dim currentVal As Integer
Dim counter As Integer
counter = 1
Dim R As Range
For Each R In rng
    Select Case DFColor(R)

        Case "RGB(255,0,0)" '3 'Red
            currentVal = 0

        Case "RGB(255,230,153)" '44 Amber
            currentVal = 1

        Case "RGB(0,176,80)" '4 Green
            currentVal = 3

        Case "RGB(255,255,0)" '6 Yellow
            currentVal = 5
        '***
        '(Add more Case statements here if you need to detect more conditional formatting colors.)
        '***

        Case "RGB(210,239,255)" '= -4142, Cell has no conditional formatting
            currentVal = 0
        Case Else
            currentVal = 0
    End Select
    cf_Cells(counter) = currentVal
    counter = counter + 1
Next R

CFV = cf_Cells

End Function


Sub Test__DFColor()
MsgBox DFColor(ActiveCell)
End Sub
Function DFColor(ByVal R As Range)
DFColor = Get_This_Cells_RGB_Color(Evaluate("Helper(" & R.Address() & ")"))
End Function
Private Function Helper(ByVal R As Range) As Double
Helper = R.DisplayFormat.Interior.Color
End Function


Sub Test__Get_This_Cells_RGB_Color()
MsgBox Get_This_Cells_RGB_Color(255)
End Sub
Function Get_This_Cells_RGB_Color(color_Constant_from_Excel As Long)
'Code is from https://www.thespreadsheetguru.com/the-code-vault/2014/11/5/retrieve-excel-cells-font-fill-rgb-color-code
'PURPOSE: Output the RGB color code for the ActiveCell's Font Color
'SOURCE: www.TheSpreadsheetGuru.com

Dim hexColor As String
hexColor = Right("000000" & Hex(color_Constant_from_Excel), 6)
Get_This_Cells_RGB_Color = "RGB(" & CInt("&H" & Right(hexColor, 2)) & "," & CInt("&H" & Mid(hexColor, 3, 2)) & "," & CInt("&H" & Left(hexColor, 2)) & ")"
End Function
 
Last edited:
Upvote 0
Solution
Thanks for posting your mini-sheet with the conditional formatting. (y)
One thing that highlights is that your CF has gone out of control somewhat with the same CF often broken into small range segments. It might be worth removing all that CF at some stage and re-applying it in a more organised manner. :)

See if this does what you want. It is not based on the actual CF colour of the cells, but the CF rules you have applied.

I have built a helper table in rows 25:30, based on your conditional formatting settings from post #7. This table could be anywhere (with formula adjustments). Also, these rows could be hidden or the table could be put on another worksheet.
Row 26 is not really necessary, I just put it there so I could better visually check which columns matched the data above.
Row 24 is the multiplier, 4 for the first 4 columns, but this structure would allow you to change the multiplier for any column if you later want.
Range Q27:Q30 is the points for each colour. Again, this could be adjusted here later if you want.

I have highlighted cell J28 as you had two ambiguous CF rules for that column:
1633757302306.png

The number 20 fits both of those rules. I have assumed the first rule shown here is correct and the red rule should be <20. If I have that the wrong way around then change J28 to 21.

There is nothing in my solution about the different room types as you said that you had that covered with Data Validation.

Anyway, see if this is heading in the right direction.

If you don't like the long worksheet formula in column Q, then you could also use this very simple user-defined function, still with the same helper cells, and shown in column R.

VBA Code:
Function TotalScore(rData As Range, rLookup As Range, rPoints As Range, rMultiplier As Range) As Double
  Dim i As Long
 
  For i = 1 To rData.Columns.Count
    TotalScore = TotalScore + Application.Lookup(rData(i), Application.Index(rLookup, 0, i), rPoints) * rMultiplier(i)
  Next i
End Function

Woodpusher147.xlsm
FGHIJKLMNOPQR
51234567891011
6185450333030
7101702554504646
84574688
91107272828
101077382828
11257991616
121078010455252
138411451515
1485152424
1599141616
161001212
171051212
181062020
19
20
21
22
23
24
2544441111111<- Multiplier
261234567891011Points
27000000000000
288570558207018252035751
29100751065247623362244823
30106801576308532523450895
Sheet1
Cell Formulas
RangeFormula
Q6:Q18Q6=LOOKUP(F6,F$27:F30,Q$27:Q$30)*F$25+LOOKUP(G6,G$27:G30,Q$27:Q$30)*G$25+LOOKUP(H6,H$27:H30,Q$27:Q$30)*H$25+LOOKUP(I6,I$27:I30,Q$27:Q$30)*I$25+LOOKUP(J6,J$27:J30,Q$27:Q$30)*J$25+LOOKUP(K6,K$27:K30,Q$27:Q$30)*K$25+LOOKUP(L6,L$27:L30,Q$27:Q$30)*L$25+LOOKUP(M6,M$27:M30,Q$27:Q$30)*M$25+LOOKUP(N6,N$27:N30,Q$27:Q$30)*N$25+LOOKUP(O6,O$27:O30,Q$27:Q$30)*O$25+LOOKUP(P6,P$27:P30,Q$27:Q$30)*P$25
R6:R18R6=TotalScore(F6:P6,F$27:P$30,Q$27:Q$30,F$25:P$25)
 
Upvote 0
One thing that highlights is the your CF has gone out of control somewhat with the same CF often broken into small range segments. It might be worth removing all that CF at some stage and re-applying it in a more organised manner. :)
Was there something wrong with my proposal of using the VBA code I provided to do this for him?

Why do you not want to save him a lot of headache and clicking and room for human error when setting up the conditional formatting rules manually in the conditional formatting window instead of doing it all with a click of a button?

It is as though you completely disregarded the conditional formatting generating code (which works in all recent versions of Office for sure) as a plausible long-term solution. The only new thing he needs to learn is to press Alt F11 to open the VBA editor window because:
  • I made a special effort to put the "real/nasty" VBA code in subs that he doesn't even have to look at.

  • Gave him simple instructions to follow to set everything up.

  • The biggest part of that task is for him to essentially fill in your table (which you are requiring him to do also, of course).
    • By him filling in "my table" in the code, in addition to setting up the point system, he simultaneously sets up a direct connection to the conditional formatting colors of the cells and his point system without any extra effort.

    • Your solution is asking for him to do the same amount of work as mine, in addition to asking him to figure out how he wants to do the conditional formatting in a more organized way. Even if he gets organized, there is a lot of room for human error when manually dealing with the conditional formatting rule menu to setting up/verifying 44+ conditional formatting rules.

As a side note, I know that my VBA code generates the exact same conditional formatting rules shown in his spreadsheet XL2BB capture, because I copied all of his conditional formatting rules from his spreadsheet capture and pasted them into an Excel spreadsheet and deleted duplicates (by using the middle/condition column as the duplicate column) to find that there were 44 unique formatting rules (which makes sense since it matches his 4x11 table). And I wrote the conditional formatting (re)generating code based off of that list of 44 unique rules.

See if this does what you want. It is not based on the actual CF colour of the cells, but the CF rules you have applied.
But that's not what he asked for by a long-shot. I may have added in too much (by adding in the 0 multipliers when he already took care of them with data validation), but that's much better than not delivering the main functionality that was asked for.

Perhaps the point of the coloring system is for him to also be able to visually see who is doing well and who isn't. Your solution is focusing only on the number aspect of the system.

Your approach indeed does guarantee that the point system is correct regardless of whether or not he gets the conditional formatting correct, but it therefore also requires no solid connection to the coloring system and the point system (which is what he was asking for/expecting to get from us).

If, for example, he wants to bring an employee to his office and show them the spreadsheet, with your approach, he cannot (with upmost certainty) tell them that "they are in the red . . . they need to get to amber, or they're out" unless he first cross-references the color name with the number in the table you made . . . if he is to continue to create this large amount of conditional formatting rules by hand. He could wrongly tell someone that they are in the red if he made a typo of 20 in the hideous conditional formatting menu instead of typing 21. He can make a typo in the VBA window too, but it's far less likely than the former.

There is nothing in my solution about the different room types as you said that you had that covered with Data Validation.
In your table, you have an array of multipliers as I have. What difference does it make if he modifies the list of multipliers in your table or the one in my formula?

But if that's undesirable enough to persuade him to disregard my solution . . . well, it's really easy to make mine not consider the room types:
This:
Excel Formula:
=SUMPRODUCT(CFV(F6:P6),{4,4,4,4,1,1,1,1,1,1,1})
Instead of this:
Excel Formula:
=SUMPRODUCT(CFV(F6:P6),IF(D6="Bedroom",{4,4,4,0,0,0,0,0,1,1,1},{4,4,4,4,1,1,1,1,0,0,1}))

(which is even shorter), but what does it hurt to leave that in? I know he said that he did data validation, but mine (with the 0 multipliers left in) adds a second level of security that the correct points are correctly calculated.


I honestly got confused (and thought to take into consideration the 0 multipliers) when he used the following noun to describe how the multipliers of 4 need to be taken care of.
The other complication is that columns 1,2,3 and 4 will score 4 times more than all other columns but I guess I can do this by having the formula/code populate hidden cell which I can then simply refer to this x4 for the cells in rows 1,2,3,4

What was wrong for me to take care of the multipliers of 0 also? It was as easy as 0, 1, 4. And my formula (with the IF and the 0's) is so short, it's easy to learn what it does . . . I can't say that formula you posted is as simple. My VBA code may do the majority of the work for my solution, but it's not something he ever needs to actually understand in full to be able to make major system design changes in the future, but your formula requires nothing less . . . especially if he decides to add or remove columns.
 
Upvote 0
Was there something wrong with my proposal of using the VBA code I provided to do this for him?
I have no idea - I didn't test it. I was simply offering an alternative. What is best for the OP is for the OP to decide.
 
Upvote 0
THank you both once again for taking your time to help, I really appreciate it.

I have started trying CMOWLA's way so apologies to Peter_SSs and thank you.

SO, I have changed a lot of the numbers in the conditional formatting module to match the below keys
Column1234567891011
Red > Below acceptable standards.less than 85%less than 70%less than 5less than 65%less than 20%less than 75%less than 20%less than 20%less than 35%less than 50%less than 80%
Amber > Improvement needed to meet acceptable standards.85% -99%70-74%5+65% - 69%20% - 23%75% - 79%20% - 25%21% - 25%35% - 39%50% - 64%80 - 84%
Green > Meets acceptable standards.100%-105%75-79%10+70% - 74%24% - 29%80% - 84%26% - 33%26% - 33%40% - 59%65% - 74%85% - 89%
Gold> OutstandingOver 105%80% and over15+75% and over30% and over85% and over31% and over31% and over60% and over75% and over90% and over

Really sorry I messed the last one up and caused you any confusion :/
I also changed the row to for now as this is enough (is this as simple as changing this number and rerunning the module if I add more people in future?)

VBA Code:
Sub Set_Conditional_Formatting()
Dim firstRow&, lastRow&, columnLetter$, red, amber, green, gold

red = RGB(255, 0, 0)  'Red
amber = RGB(255, 230, 153) 'Amber
green = RGB(0, 176, 80) 'Green
gold = RGB(255, 255, 0) 'Gold
fontColorForRedCells = RGB(255, 255, 255) 'White

firstRow = 6
lastRow = 22


Call DeleteFormatConditions("F", "P", firstRow, lastRow)

columnLetter = "F"
Call LessThan(85, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(85, 99, columnLetter, firstRow, lastRow, amber)
Call Between(100, 105, columnLetter, firstRow, lastRow, green)
Call GreaterThan(105, columnLetter, firstRow, lastRow, gold)

columnLetter = "G"
Call LessThan(70, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(70, 74, columnLetter, firstRow, lastRow, amber)
Call Between(75, 79, columnLetter, firstRow, lastRow, green)
Call GreaterThan(79, columnLetter, firstRow, lastRow, gold)

columnLetter = "H"
Call LessThan(5, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(5, 9, columnLetter, firstRow, lastRow, amber)
Call Between(10, 14, columnLetter, firstRow, lastRow, green)
Call GreaterThan(14, columnLetter, firstRow, lastRow, gold)

columnLetter = "I"
Call LessThan(65, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(65, 69, columnLetter, firstRow, lastRow, amber)
Call Between(70, 74, columnLetter, firstRow, lastRow, green)
Call GreaterThan(74, columnLetter, firstRow, lastRow, gold)

columnLetter = "J"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 23, columnLetter, firstRow, lastRow, amber)
Call Between(24, 29, columnLetter, firstRow, lastRow, green)
Call GreaterThan(29, columnLetter, firstRow, lastRow, gold)

columnLetter = "K"
Call LessThan(75, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(75, 79, columnLetter, firstRow, lastRow, amber)
Call Between(80, 84, columnLetter, firstRow, lastRow, green)
Call GreaterThan(84, columnLetter, firstRow, lastRow, gold)

columnLetter = "L"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 25, columnLetter, firstRow, lastRow, amber)
Call Between(26, 33, columnLetter, firstRow, lastRow, green)
Call GreaterThan(33, columnLetter, firstRow, lastRow, gold)

columnLetter = "M"
Call LessThan(20, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(20, 25, columnLetter, firstRow, lastRow, amber)
Call Between(26, 33, columnLetter, firstRow, lastRow, green)
Call GreaterThan(33, columnLetter, firstRow, lastRow, gold)

columnLetter = "N"
Call LessThan(35, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(35, 39, columnLetter, firstRow, lastRow, amber)
Call Between(40, 59, columnLetter, firstRow, lastRow, green)
Call GreaterThan(59, columnLetter, firstRow, lastRow, gold)

columnLetter = "O"
Call LessThan(50, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(50, 64, columnLetter, firstRow, lastRow, amber)
Call Between(65, 74, columnLetter, firstRow, lastRow, green)
Call GreaterThan(74, columnLetter, firstRow, lastRow, gold)

columnLetter = "P"
Call LessThan(80, columnLetter, firstRow, lastRow, red, fontColorForRedCells)
Call Between(80, 84, columnLetter, firstRow, lastRow, amber)
Call Between(85, 89, columnLetter, firstRow, lastRow, green)
Call GreaterThan(89, columnLetter, firstRow, lastRow, gold)

End Sub

Sub DeleteFormatConditions(columnLetter1 As String, columnLetter2 As String, firstRow As Long, lastRow As Long)
Range(columnLetter1 & firstRow & ":" & columnLetter2 & lastRow).FormatConditions.Delete
End Sub

Sub LessThan(num As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:=1, Formula2:=num - 1)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub

Sub GreaterThan(num As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:=num)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub

Sub Between(num1 As Variant, num2 As Variant, columnLetter As String, firstRow As Long, lastRow As Long, colorr As Variant, Optional ByVal fontColor As Long = 0)
With Range(columnLetter & firstRow & ":" & columnLetter & lastRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:=num1, Formula2:=num2)
    .Interior.Color = colorr
    .Font.Color = fontColor
    .StopIfTrue = False
End With
End Sub

However, when I ran this I had all cells in column G & H turn green except G22 and K9 turns Orange (RGB 255,192,0). This is only when the cells are empty, the conditional formatting is working spot on other than this.
1633776227868.png


THank you again
 
Upvote 0
THank you both once again for taking your time to help, I really appreciate it.
You're welcome!

I also changed the row to for now as this is enough (is this as simple as changing this number and rerunning the module if I add more people in future?)
Yes, it should be. But for the following:

firstRow = 6
lastRow = 22

However, when I ran this I had all cells in column G & H turn green except G22 and K9 turns Orange (RGB 255,192,0). This is only when the cells are empty, the conditional formatting is working spot on other than this.
perhaps I can add a line of code to clear the conditional formatting of all of the sheet before it applies the (current) conditional formatting.

Can you manually go clear all conditional formatting rules from the spreadsheet (not just the selection) and run the code again and see if it still gives you this result? (If so, I will check it and see what's wrong.)

EDIT:
For example, (if you didn't try it yet), replace the line of code:
VBA Code:
Call DeleteFormatConditions("F", "P", firstRow, lastRow)
with:
VBA Code:
ActiveSheet.Cells.FormatConditions.Delete

And see if it works now. (And if so, one less thing to worry about if you shift the table to the left or right in the future!)
 
Last edited:
Upvote 0
I have now added the point calc module code and formula and it looks fantastic.
1633777559528.png


I still have the issue with the empty cells being green and 1 orange but Im sure you will spot that issue in no time.

Am I right in thinking, if we change the multiplier of different columns, I simply change the number here
=SUMPRODUCT(CFV(F11:P11),IF(D11="Bedroom",{4,4,4,0,0,0,0,0,1,1,0},{4,4,4,4,1,1,1,1,0,0,1}))
So if Bedroom decided that Column 10 was multiplied by 4 I would simply change
=SUMPRODUCT(CFV(F11:P11),IF(D11="Bedroom",{4,4,4,0,0,0,0,0,4,1,0},{4,4,4,4,1,1,1,1,0,0,1}))
and the same for any others?
 
Upvote 0
You're welcome!


Yes, it should be. But for the following:


perhaps I can add a line of code to clear the conditional formatting of all of the sheet before it applies the (current) conditional formatting.

Can you manually go clear all conditional formatting rules from the spreadsheet (not just the selection) and run the code again and see if it still gives you this result? (If so, I will check it and see what's wrong.)

EDIT:
For example, (if you didn't try it yet), replace the line of code:
VBA Code:
Call DeleteFormatConditions("F", "P", firstRow, lastRow)
with:
VBA Code:
ActiveSheet.Cells.FormatConditions.Delete

And see if it works now. (And if so, one less thing to worry about if you shift the table to the left or right in the future!)
I cleared all rules then ran again and its worked fine. :)
 
Upvote 0

Forum statistics

Threads
1,214,819
Messages
6,121,739
Members
449,050
Latest member
excelknuckles

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