Coloring the border of an Excel cell is a trivial task. The LineColor feature in Excel is easy to use out of the box:
However, whenever half of the cell needs to be colored, the trick is a bit more tough and it includes VBA. The idea is to use the AddConnector method of Excel-VBA, which connects two dots with a connector. The position of these two dots could be set in relation to the cell, which we would like to border in half:
|
1 2 3 4 5 |
Set myRange = .Range("E10") 'Selection Dim left As Long: left = myRange.left Dim top As Long: top = myRange.top Dim width As Long: width = myRange.width Dim heigth As Long: heigth = myRange.Height |
The whole code runs rather flawlessly, coloring half of the border of the cell, whichever is mentioned in Set myRange. If you want to make the code work for the currently selected cell, make sure to replace With Worksheets("Sheet1") with With ActiveSheet and Set myRange = .Range("E10") with Selection. In cases like these, you are allowed to use Select, it is not that bad.
This is how the code runs (for the left part):
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
Sub FormatHalfOfTheSelectedCell() Dim myRange As Range Dim color As Long: color = RGB(0, 0, 0) Dim myShape As Shape With Worksheets("Sheet1") 'With ActiveSheet Set myRange = .Range("E10") 'Selection Dim left As Long: left = myRange.left Dim top As Long: top = myRange.top Dim width As Long: width = myRange.width Dim heigth As Long: heigth = myRange.Height 'Top line: Set myShape = .Shapes.AddConnector(msoConnectorStraight, left, top, left + (width) / 2, top) myShape.Line.ForeColor.RGB = color 'Left line: Set myShape = .Shapes.AddConnector(msoConnectorStraight, left, top, left, top + myRange.Height) myShape.Line.ForeColor.RGB = color Set myRange = myRange.Offset(1) left = myRange.left top = myRange.top width = myRange.width heigth = myRange.Height 'Bottom line: Set myShape = .Shapes.AddConnector(msoConnectorStraight, left, top, left + (width) / 2, top) myShape.Line.ForeColor.RGB = RGB(200, 0, 0) End With End Sub |
For the right part it is this one:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
Sub FormatRightPartOfSelectedCell() Dim myRange As Range Dim color As Long: color = RGB(0, 0, 0) Dim myShape As Shape With Worksheets("Sheet1") 'With ActiveSheet Set myRange = .Range("E10") 'Selection Dim left As Long: left = myRange.left Dim top As Long: top = myRange.top Dim width As Long: width = myRange.width Dim heigth As Long: heigth = myRange.Height 'Top line: Set myShape = .Shapes.AddConnector(msoConnectorStraight, left + (width) / 2, top, left + width, top) myShape.Line.ForeColor.RGB = color 'Right line Set myShape = .Shapes.AddConnector(msoConnectorStraight, left + width, top, left + width, top + myRange.Height) myShape.Line.ForeColor.RGB = color Set myRange = myRange.Offset(1) left = myRange.left top = myRange.top width = myRange.width heigth = myRange.Height 'Bottom Line: Set myShape = .Shapes.AddConnector(msoConnectorStraight, left + (width) / 2, top, left + width, top) myShape.Line.ForeColor.RGB = RGB(200, 0, 0) End With End Sub |
The VBA code is available also here!
Enjoy it 🙂 !