locked
Highlight cells in rows with conditions. RRS feed

  • 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

    Saturday, September 19, 2015 8:06 PM

Answers

  • 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)

    • Marked as answer by Ahmed Morsyy Sunday, September 20, 2015 1:07 PM
    Sunday, September 20, 2015 9:44 AM

All replies

  • 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)

    • Proposed as answer by André Santo Saturday, September 19, 2015 9:41 PM
    Saturday, September 19, 2015 8:26 PM
  • Thank you Hans, but the results are different than expected.

    I'll do review the code again. 

    Sunday, September 20, 2015 12:58 AM
  • 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)

    • Marked as answer by Ahmed Morsyy Sunday, September 20, 2015 1:07 PM
    Sunday, September 20, 2015 9:44 AM
  • Thanks Hans, 

    It is awesome.

    Sunday, September 20, 2015 1:08 PM