Add border to adjacent cell

[Vincent88]

Hi, Need help to make the Part C code works ( the code is to add border to 2 adjacent cells if value condition of the two cells fall to the two variants gp1 and gp2 otherwise no border of cells (resume to normal).
Cell range in both Part B and C are the same.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Select Case Sh.Name
    Case "Data"
      Exit Sub
    Case Else
  End Select

'PART A
'ProperCase in Column A

Dim LastRow As Long
LastRow = Range("A3").End(xlDown).Row

If Target.CountLarge > 1 Then Exit Sub
On Error GoTo ErrHandler:

If Not Intersect(Target, Range("A3:A" & LastRow)) Is Nothing Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = StrConv(Target.Text, vbProperCase)
Application.EnableEvents = True
End If
End If



'PART B
'UpperCase From Range(C:AG)
If Not Intersect(Target, Range("C3:AG" & LastRow)) Is Nothing Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = UCase(Target.Text)
Application.EnableEvents = True
End If
End If
ErrHandler:
Application.EnableEvents = True

'PART C
'Conditions to HIGHLIGHT Cells
If Not Intersect(Target, Range("C3:AG" & LastRow)) Is Nothing Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Dim c As Range
Dim gp1, gp2 As Variant
Dim rng As Range


gp1 = Array("D", "G")
gp2 = Array("E", "N")
'LastRow = Range("A3").End(xlDown).Row

For Each c In Range("C3", Range("AG" & Rows.Count).End(xlUp))
    If c.Value = gp1 And c.Offset(, -1).Value = gp2 Then
    Set rng = Range(c, c.Offset(, -1))
    
   'Add Border around Range
    rng.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, ColorIndex:=32
    
Else
     'Remove All Borders if condition not meets
     rng.Borders.LineStyle = xlLineStyleNone
  End If
 
Next c
 
End Sub

 

[mse330]

For 'Part C' only ...

'PART C
'Conditions to HIGHLIGHT Cells
If Not Intersect(Target, Range("C3:AG" & LastRow)) Is Nothing Then
   If Not IsNumeric(Target.Value) Then
      Application.EnableEvents = False
      Dim c As Range, rng As Range
      
      For Each c In Range("C3", Range("AG" & Rows.Count).End(xlUp))
         If (c = "D" Or c = "G") And (c.Offset(, -1) = "E" Or c.Offset(, -1) = "N") Then
            Set rng = Range(c, c.Offset(, -1))
            'Add Border around Range
            rng.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, ColorIndex:=32
         Else
            'Remove All Borders if condition not meets
            rng.Borders.LineStyle = xlLineStyleNone
         End If
      Next c
   End If
End If
[/vba]

 

[Vincent88]

Hi mse330,
it shows error

 

[Vincent88]

Hi mse330, I need to create the criteria one by one to make it works. Thanks anyway.

 

[mse330]

What was the error you were getting ?