Highlight cells in rows with conditions.

Question

Hello,

I want to apply this logic using VBA code:

If cells B and C has the same value that is different than cell A then highlight B and C yellow

If cells B and C has different value, but cell B <> A, then highlight B and C red

If cells B and C has different value, but cell B = A, then highlight B and C blue

If cells B and C has different value, but cell C = A, then highlight  B and C green

If cell A, B and C has same value (even blank) then keep without color

I want to compare the results of 3 groups, I'll run the macro after pasting the results.

Appreciate your help. Thanks

Answer 1

You could use conditional formatting for this, but if you prefer VBA:

Sub ColorCells()
    Const FirstRow = 2
    Dim LastRow As Long
    Dim CurRow As Long
    Dim ValB, ValC, ValD
    Application.ScreenUpdating = False
    LastRow = Range("B:D").Find(What:="*", SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
    For CurRow = FirstRow To LastRow
        ValB = Range("B" & CurRow).Value
        ValC = Range("C" & CurRow).Value
        ValD = Range("D" & CurRow).Value
        If ValB = ValC And ValB = ValD Then
            Range("C" & CurRow).Resize(, 2).Interior.ColorIndex = xlColorIndexNone
        ElseIf ValB = ValC And ValB <> ValD Then
            Range("C" & CurRow).Resize(, 2).Interior.Color = RGB(0, 255, 255)
        ElseIf ValB <> ValC And ValB = ValD Then
            Range("C" & CurRow).Resize(, 2).Interior.Color = RGB(0, 255, 0)
        ElseIf ValB <> ValC And ValC = ValD Then
            Range("C" & CurRow).Resize(, 2).Interior.Color = vbYellow
        Else
            Range("C" & CurRow).Resize(, 2).Interior.Color = vbRed
        End If
    Next CurRow
    Application.ScreenUpdating = True
End Sub

---

Regards, Hans Vogelaar (http://www.eileenslounge.com)

Answer 2

Thank you Hans, but the results are different than expected.

I'll do review the code again. 

Answer 3

Sorry, I looked at columns B:D instead of A:C.

Sub ColorCells()
    Const FirstRow = 2
    Dim LastRow As Long
    Dim CurRow As Long
    Dim ValA, ValB, ValC
    Application.ScreenUpdating = False
    LastRow = Range("A:C").Find(What:="*", SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
    For CurRow = FirstRow To LastRow
        ValA = Range("A" & CurRow).Value
        ValB = Range("B" & CurRow).Value
        ValC = Range("C" & CurRow).Value
        If ValA = ValB And ValA = ValC Then
            Range("B" & CurRow).Resize(, 2).Interior.ColorIndex = xlColorIndexNone
        ElseIf ValA = ValB And ValA <> ValC Then
            Range("B" & CurRow).Resize(, 2).Interior.Color = RGB(0, 255, 255)
        ElseIf ValA <> ValB And ValA = ValC Then
            Range("B" & CurRow).Resize(, 2).Interior.Color = RGB(0, 255, 0)
        ElseIf ValA <> ValB And ValB = ValC Then
            Range("B" & CurRow).Resize(, 2).Interior.Color = vbYellow
        Else
            Range("B" & CurRow).Resize(, 2).Interior.Color = vbRed
        End If
    Next CurRow
    Application.ScreenUpdating = True
End Sub

---

Regards, Hans Vogelaar (http://www.eileenslounge.com)

Answer 4

Thanks Hans, 

It is awesome.