Change a cell colour based on a group of cells with different colours

Question

I have a spreadsheet that contains various information and is heavily conditionally formatted. Now the question is..... I have a range of 4 cells, all cells could comeback as green, if all criteria is met, or one of the cells my comeback as amber, or red if criteria is partially, or not met at all. I want to change the colour of a cell that is using an autosum, but also want to change it to green if ALL cells are green, Amber if one or more cells appear amber, or Red, if one or more cells appear red. But there could also be a mix, so one cell could be green, one amber and one red. so not interested in the value of the cell, just the colour. I then also want to transfer the data (Value & colour) onto a different sheet altogether. Any Ideas??

Answer 1

To answer the first part of your questions, below is the simple code, that you will need to adjust to your needs (change ranges, make sure your use correct colors etc.)

Additionally if you want to perform it for larger set of ranges, you will need to loop this macro using : For ... Next or other loops.

Sub interiorcolor()


Dim Range1, Range2, Range3, Range4 As Range

Set Range1 = Sheets("Sheet1").Range("A1")
Set Range2 = Sheets("Sheet1").Range("A2")
Set Range3 = Sheets("Sheet1").Range("A3")
Set Range4 = Sheets("Sheet1").Range("A4")


If Range1.Interior.ColorIndex = 3 Or Range2.Interior.ColorIndex = 3 Or Range3.Interior.ColorIndex = 3 Or Range4.Interior.ColorIndex = 3 Then

Sheets("Sheet1").Range("A5").Interior.ColorIndex = 3

ElseIf Range1.Interior.ColorIndex = 53 Or Range2.Interior.ColorIndex = 53 Or Range3.Interior.ColorIndex = 53 Or Range4.Interior.ColorIndex = 53 Then

Sheets("Sheet1").Range("A5").Interior.ColorIndex = 53

ElseIf Range1.Interior.ColorIndex = 43 And Range2.Interior.ColorIndex = 43 And Range3.Interior.ColorIndex = 43 And Range4.Interior.ColorIndex = 43 Then

Sheets("Sheet1").Range("A5").Interior.ColorIndex = 43

Else

Sheets("Sheet1").Range("A5").Interior.ColorIndex = 2

End If


End Sub