[excel] Border around each cell in a range

I am trying to create a simple function that will add borders around every cell in a certain range. Using the wonderful recording this generates a ton of code which is quite useless. The code below will display a 'table' of data, around each cell in this range I would like to add a border. Online I haven't been able to find a simple or clear answer for this.

All help is much appreciated!

Set DT = Sheets("DATA")
endRow = DT.Range("F" & Rows.Count).End(xlUp).Row
result = 3

For I = 2 To endRow
    If DT.Cells(I, 6).Value = Range("B1").Value Then
        Range("A" & result) = DT.Cells(I, 6).Value
        Range("B" & result) = DT.Cells(I, 1).Value
        Range("C" & result) = DT.Cells(I, 24).Value
        Range("D" & result) = DT.Cells(I, 37).Value
        Range("E" & result) = DT.Cells(I, 3).Value
        Range("F" & result) = DT.Cells(I, 15).Value
        Range("G" & result) = DT.Cells(I, 12).Value
        Range("H" & result) = DT.Cells(I, 40).Value
        Range("I" & result) = DT.Cells(I, 23).Value
        result = result + 1
    End If
Next I

This question is related to excel vba

The answer is


I have a set of 15 subroutines I add to every Coded Excel Workbook I create and this is one of them. The following routine clears the area and creates a border.

Sample Call:

Call BoxIt(Range("A1:z25"))

Subroutine:

Sub BoxIt(aRng As Range)
On Error Resume Next

    With aRng

        'Clear existing
        .Borders.LineStyle = xlNone

        'Apply new borders
        .BorderAround xlContinuous, xlThick, 0
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .Weight = xlMedium
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .Weight = xlMedium
        End With
    End With

End Sub

xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid

Here's another way

Sub testborder()

    Dim rRng As Range

    Set rRng = Sheet1.Range("B2:D5")

    'Clear existing
    rRng.Borders.LineStyle = xlNone

    'Apply new borders
    rRng.BorderAround xlContinuous
    rRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    rRng.Borders(xlInsideVertical).LineStyle = xlContinuous

End Sub

For adding borders try this, for example:

Range("C11").Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A15:D15").Borders(xlEdgeBottom).LineStyle = xlContinuous

Hope that syntax is correct because I've done this in C#.


The following can be called with any range as parameter:

Option Explicit

Sub SetRangeBorder(poRng As Range)
    If Not poRng Is Nothing Then
        poRng.Borders(xlDiagonalDown).LineStyle = xlNone
        poRng.Borders(xlDiagonalUp).LineStyle = xlNone
        poRng.Borders(xlEdgeLeft).LineStyle = xlContinuous
        poRng.Borders(xlEdgeTop).LineStyle = xlContinuous
        poRng.Borders(xlEdgeBottom).LineStyle = xlContinuous
        poRng.Borders(xlEdgeRight).LineStyle = xlContinuous
        poRng.Borders(xlInsideVertical).LineStyle = xlContinuous
        poRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End If
End Sub

Examples:

Call SetRangeBorder(Range("C11"))
Call SetRangeBorder(Range("A" & result))
Call SetRangeBorder(DT.Cells(I, 6))
Call SetRangeBorder(Range("A3:I" & endRow))

You can also include this task within another macro, without opening a new one:

I don't put Sub and end Sub, because the macro contains much longer code, as per picture below

With Sheets("1_PL").Range("EF1631:JJ1897")
    With .Borders
    .LineStyle = xlContinuous
    .Color = vbBlack
    .Weight = xlThin
    End With
[![enter image description here][1]][1]End With