VBA - Applying border around the areas with value text

Question

The current code :

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:

Answer 1

Try this:

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