Vincent88
Active Member
- Joined
- Mar 5, 2021
- Messages
- 382
- Office Version
- 2019
- Platform
- Windows
- Mobile
Hi Guys,
Need recommendiation to make adjustments in two areas.
1. I want to add borders to two adjacent cells but my code only adds border to the first cell (see image provided),
2. Also there are four conditions which trigger the function and how to shorten/simplify it.
Please help.
Need recommendiation to make adjustments in two areas.
1. I want to add borders to two adjacent cells but my code only adds border to the first cell (see image provided),
2. Also there are four conditions which trigger the function and how to shorten/simplify it.
Please help.
VBA Code:
Option Explicit
Sub HighlightCells1()
Dim c As Range
Dim rng As Range
For Each c In Range("C3", Range("AG" & Rows.Count).End(xlUp))
If c = "E" And c.Offset(, 1) = "D" Then
Set rng = Range(c, c.Offset(, 1))
With rng
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThick
.Borders.Color = vbBlue
End With
ElseIf c = "N" And c.Offset(, 1) = "D" Then
Set rng = Range(c, c.Offset(, 1))
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThick
.Color = vbBlue
End With
ElseIf c = "E" And c.Offset(, 1) = "G" Then
Set rng = Range(c, c.Offset(, 1))
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThick
.Color = vbBlue
End With
ElseIf c = "N" And c.Offset(, 1) = "G" Then
Set rng = Range(c, c.Offset(, 1))
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThick
.Color = vbBlue
End With
Else
Set rng = Range(c, c.Offset(, 1))
'Remove All Borders if condition not meets
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
End If
Next c
End Sub