VBA - Applying border around the areas with value/text

The code that I am currently using:

Dim border As Range
Dim brng As Range
Set border = ThisWorkbook.ActiveSheet.UsedRange
For Each brng In border
brng.BorderAround _ LineStyle:=xlContinuous, _ Weight:=xlThin
End If
Next brng

The screenshot on the left is what I currently get, and the screenshot on the right is what I am trying to achieve:

Thank you in advanced.

3 Answers

Please try the next way:

Sub BorderArroudAreas() Dim sh As Worksheet, lastR As Long, rng As Range, rngBord As Range, arrBord, El, A As Range Set sh = ActiveSheet lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row on B:B Set rng = sh.Range("B1:B" & lastR).SpecialCells(xlCellTypeConstants) 'the B:B discontinuous range (empty rows is a delimiter for the range areas) 'obtain a range having the same areas in terms of rows, but all used range columns: Set rngBord = Intersect(rng.EntireRow, sh.UsedRange.EntireColumn) 'create an array with numbers from 7 to 12 (the borders type constants...) arrBord = Application.Evaluate("Row(7:12)") 'used to place cells borders For Each A In rngBord.Areas 'iterate between the range areas For Each El In arrBord 'place borders on each area cells: With A.Borders(El) .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 0 End With Next El Next A
End Sub

It should be faster even for large ranges, not placing borders for each cell...

BorderAround is just put a border within the specified range.

If the original data has no border at all and you expect a result as in your right side of the image, then need to apply horizontal, vertical, etc.

Sub test()
For Each brng In ActiveSheet.Columns(2).SpecialCells(xlConstants).Areas
With brng.Offset(0, -1).Resize(brng.Rows.Count, 5) .select '---> use to check when in debug mode if the range is correct, remove this line later on .BorderAround LineStyle:=xlContinuous, Weight:=xlThin With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin End With
End With
Next
End Sub

Your code is working but you're not excluding blank rows from your loop which means all cells in your UsedRange get a border. You should add a check for blank rows and exclude those from getting borders.

Dim border As Range
Dim brng As Range
Set border = ThisWorkbook.ActiveSheet.UsedRange
For Each brng In border If WorksheetFunction.CountA(brng.EntireRow) > 0 Then brng.BorderAround _ LineStyle:=xlContinuous, _ Weight:=xlThin End If
Next brng

I see you have an End If in your code already, not sure where you begin your If.