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.

4

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...

1

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

0

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.

1

Your Answer

Sign up or log in

Sign up using Google Sign up using Facebook Sign up using Email and Password Submit

Post as a guest

Post Your Answer Discard

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.