Search code examples
excelvbacell

Change cell colour based on 2 other cell colours

I need to create a VBA formula that will help me to automatically change the color of a cell, when I fill other 2 cells manually with other colors.

Here is an example:

enter image description here

As a result of manually filling in cells K and M, I need cell Q to be automatically filled in green in the first row.

The same for the second one: if I fill K with yellow + M with green, the result of Q must be that it is filled in green.

Is this possible? It would be enough for me if you could give me the example of the first two conditions to build the following ones myself.

Here's my code:

Sub RatingColor()
    If range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(146, 208, 80) Then
     range("J13").Interior.Color = RGB(146, 208, 80)
     ElseIf range("F13").Interior.Color = RGB(255, 255, 0) And range("H13").Interior.Color = RGB(146, 208, 80) Then
     range("J13").Interior.Color = RGB(146, 208, 80)
     
     ElseIf range("F13").Interior.Color = RGB(255, 192, 0) And range("H13").Interior.Color = RGB(146, 208, 80) Then
     range("J13").Interior.Color = RGB(255, 255, 0)
     ElseIf range("F13").Interior.Color = RGB(255, 255, 0) And range("H13").Interior.Color = RGB(255, 255, 0) Then
     range("J13").Interior.Color = RGB(255, 255, 0)
     ElseIf range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(255, 255, 0) Then
     range("J13").Interior.Color = RGB(255, 255, 0)
     
     ElseIf range("F13").Interior.Color = RGB(255, 192, 0) And range("H13").Interior.Color = RGB(255, 255, 0) Then
     range("J13").Interior.Color = RGB(255, 192, 0)
     ElseIf range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(255, 192, 0) Then
     range("J13").Interior.Color = RGB(255, 192, 0)
     ElseIf range("F13").Interior.Color = RGB(255, 255, 0) And range("H13").Interior.Color = RGB(255, 192, 0) Then
     range("J13").Interior.Color = RGB(255, 192, 0)
     
     ElseIf range("F13").Interior.Color = RGB(255, 192, 0) And range("H13").Interior.Color = RGB(255, 192, 0) Then
     range("J13").Interior.Color = RGB(255, 0, 0)
     ElseIf range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(255, 0, 0) Then
     range("J13").Interior.Color = RGB(255, 0, 0)
    End If
End Sub

I have create the color-formula and It works, but what I need now is the loop part and if possible, to apply this automatically everytime I change a color.

Solution

  • This is based on the permutation you have given in your post, put this in the Worksheet module that you want this code to run, take note that it will actually trigger on every change you made on the worksheet, not just when you change a color:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim colorGreen As Long
        Dim colorYellow As Long
        Dim colorOrange As Long
        Dim colorRed As Long
        Dim i As Long
        
        Const rowStart As Long = 2 'first row, change to your purpose
        Const rowEnd As Long = 20 'last row, change to your purpose
        
        'Define color to variables
        colorGreen = RGB(146, 208, 80)
        colorYellow = RGB(255, 255, 0)
        colorOrange = RGB(255, 192, 0)
        colorRed = RGB(255, 0, 0)
        
        With Sheet1 'change to correct worksheet reference
            For i = rowStart To rowEnd
                Select Case .Cells(i, 6).Interior.color 'Check cell color in Column F
                    Case colorGreen
                        Select Case .Cells(i, 8).Interior.color 'Check cell color in column H
                            Case colorGreen, colorYellow, colorOrange, colorRed: .Cells(i, 10).Interior.color = .Cells(i, 8).Interior.color
                        End Select
                    Case colorYellow
                        Select Case .Cells(i, 8).Interior.color 'Check cell color in column H
                            Case colorGreen, colorYellow, colorOrange
                                .Cells(i, 10).Interior.color = .Cells(i, 8).Interior.color
                        End Select
                    Case colorOrange
                        Select Case .Cells(i, 8).Interior.color 'Check cell color in column H
                            Case colorGreen
                                .Cells(i, 10).Interior.color = colorYellow
                            Case colorYellow
                                .Cells(i, 10).Interior.color = colorOrange
                            Case colorOrange
                                .Cells(i, 10).Interior.color = colorRed
                        End Select
                End Select
            Next i
        End With
End Sub

    enter image description here