Adjacent cells change appearance based on cells' values

[Vincent88]

Hi Guy, need help to modify the code to add one more condition to trigger the change.
If the 1st cell value is "N' and adjacent cell value is "E", then change border style of both cells.
Also how to add code to let the change restore to original (no change) when conditions not met.
Thanks

Dim c As Range, rng As Range, rng1 As Range

Set rng = Range("C3", Range("AL" & Rows.Count).End(xlUp))

For Each c In rng
    Select Case UCase(c.Value)
        Case "E", "N"
            Select Case UCase(c.Offset(, 1).Value)
                Case "D", "G"
                    Set rng1 = c.Resize(1, 2)
                    With rng1
                        .Borders.LineStyle = xlContinuous
                        .Borders.Weight = xlThick
                        '.Borders.Color = vbBlue
                        .Borders.Color = RGB(102, 0, 255)
                    End With
                            
            End Select
    End Select
Next
End If
End If

End Sub

 

[Vincent88]

To be more specific. The following five conditions should trigger the change
1st Cell value 2nd Cell value
E D
E G
N E
N D
N G

Hope somebody can help ?

 

[EXCEL MAX]

Hello Vincent88,
Try this...

Sub HighlightPairs()

    Dim c As Range, rng As Range
    
    With ActiveSheet
        Columns("C:D").ClearFormats
        Set rng = Range("C3", Cells(Rows.Count, "C").End(xlUp))
        For Each c In rng
            Select Case UCase(c.Value) & UCase(c.Offset(0, 1).Value)
                Case "ED", "EG", "NE", "ND", "NG"
                    With c.Resize(, 2)
                        .Borders.LineStyle = xlContinuous
                        .Borders.Weight = xlThick
                        .Borders.Color = RGB(102, 0, 255)
                    End With
            End Select
        Next c
    End With
    
End Sub

 

[Vincent88]

Hi EXCEL MAX,
It works fine. Thanks a lot !

 

[EXCEL MAX]

I'm glad if this was helpful.

 

[Vincent88]

Hello Vincent88,
Try this...

Sub HighlightPairs()

    Dim c As Range, rng As Range
  
    With ActiveSheet
        Columns("C:D").ClearFormats
        Set rng = Range("C3", Cells(Rows.Count, "C").End(xlUp))
        For Each c In rng
            Select Case UCase(c.Value) & UCase(c.Offset(0, 1).Value)
                Case "ED", "EG", "NE", "ND", "NG"
                    With c.Resize(, 2)
                        .Borders.LineStyle = xlContinuous
                        .Borders.Weight = xlThick
                        .Borders.Color = RGB(102, 0, 255)
                    End With
            End Select
        Next c
    End With
  
End Sub

Hi EXCEL MAX, Further trial run found if the pair of cell meets the condition and the borders of pair cell are highlighted. If any of the cell contents is cleared, the highlighted borders do not restore to normal completely (See images) and all borders can only be restored when I enter data any other cells. Any suggestion to improve this !

 

[Vincent88]

Hi EXCEL MAX,
I need to add more conditional to CASE to trigger the event but it may be too chunky to add conditions to CASE. Is it possible to use two groups of arrays in CASE ?
Array1 = ("E")
Array2=("D", "D1", "D2", "D3", "D4", "D5", "G", "K")
Array3=("N")
Array4=("D", "D1", "D2", "D3", "D4", "D5", "E","G", "K")


Something like
CASE Array1+Array2 and Array3+Array4 to trigger the change ?

 

[EXCEL MAX]

It seems easier to do that without Select Case...

Sub HighlightPairs()

    Dim c As Range, rng As Range
    Dim Array1(), Array2(), Array3(), Array4(), Array5(), vA, vArrayX, _
         vNArraysSum As Long, vN As Long, vN1 As Long, vN2 As Long
    
    Array1 = Array("E")
    Array2 = Array("D", "D1", "D2", "D3", "D4", "D5", "G", "K")
    Array3 = Array("N")
    Array4 = Array("D", "D1", "D2", "D3", "D4", "D5", "E", "G", "K")
    Array5 = Array("ED", "EG", "NE", "ND", "NG")
    vA = Array(Array1, Array2, Array3, Array4, Array5)
    vNArraysSum = UBound(Array1) + _
                  UBound(Array2) + _
                  UBound(Array3) + _
                  UBound(Array4) + _
                  UBound(Array5) + _
                  UBound(vA)
    ReDim vArrayX(vNArraysSum)
    For vN1 = 0 To UBound(vA)
        For vN2 = 0 To UBound(vA(vN1))
            vArrayX(vN) = vA(vN1)(vN2)
            vN = vN + 1
        Next vN2
    Next vN1
    With ActiveSheet
        Columns("C:D").ClearFormats
        Set rng = Range("C3", Cells(Rows.Count, "C").End(xlUp))
        For Each c In rng
            For vN = 0 To UBound(vArrayX)
                If UCase(c.Value) & UCase(c.Offset(0, 1).Value) = _
                    vArrayX(vN) Then
                    With c.Resize(, 2)
                        .Borders.LineStyle = xlContinuous
                        .Borders.Weight = xlThick
                        .Borders.Color = RGB(102, 0, 255)
                    End With
                End If
            Next vN
        Next c
    End With
    
End Sub