Yeppers, you forgot to mention those little things.
Every cell is already bordered, that makes it simpler
I have nowq been awake and coding for way too long, and I won't be back some some time.
This Compiles, but obviously, I can't test it
Option Explicit
Sub VBAX_SAmT()
Dim Namelist As Variant
Namelist = Array("Artur", "Ariel", "Jake")
SetBorders Sheets("Sheet1"), Namelist
End Sub
Private Sub SetBorders(Sht As Worksheet, Namelist As Variant)
Dim NumCols As Long
Dim Cel As Range
Dim NextCel As Range
Dim i As Long
Dim FoundName As Boolean
NumCols = Sht.Range("A1").End(xlToRight).Column
Set Cel = Sht.Range("A1")
Do
FoundName = False
For i = LBound(Namelist) To UBound(Namelist)
If Cel = Namelist(i) Then FoundName = True
Next i
If Not FoundName Then
RestoreBorders Cel.Resize(0, NumCols)
Set Cel = Cel.Offset(1)
Else
Do
Set NextCel = Cells(Cel.Cells(Cel.Count).Offset(1))
For i = LBound(Namelist) To UBound(Namelist)
If NextCel = Namelist(i) Then Set Cel = Cel.Resize(1)
Next i
Loop While Not Intersect(Cel, NextCel) Is Nothing
MakeHeavyBorders Cel
Set Cel = Cel.Rows(Cel.Rows.Count).Cells(1).Offset(1)
End If
Loop While Cel <> ""
End Sub
Private Function RestoreBorders(Rng As Range)
Dim Rw As Range
For Each Rw In Rng.Rows
Rw.Borders.Weight = xlHairline
Next
End Function
Private Function MakeHeavyBorders(Rng As Range)
Rng.Borders.Weight = xlMedium
End Function