Run-time error "91":

Hello,

ive been working on a macro to ease up thing with an excel i need to produce every couple of minutes.
a part of the code is a little buggy because it gives me error 91 marking "rngG.Select" after debug when the object the code is looking for doesnt exist:

Code:

---

Dim c As Range    Dim rngG As Range
    For Each c In Intersect(ActiveSheet.UsedRange, Columns("a"))
        If c = "Artur" Then
            If rngG Is Nothing Then Set rngG = c.EntireRow
            Set rngG = Union(rngG, c.EntireRow)
        End If
    Next c
    rngG.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

---

need your help with altering the code abit so if it doesnt find "Artur" then just continue

Try this

Code:

---

Dim c As Range   

With ActiveSheet
For Each c In Intersect(.UsedRange, .Columns(1))
    If c = "Artur" Then
With Intersect(c.EntireRow,. UsedRange).Borders
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
Else: Intersect(c.EntireRow,. UsedRange).Borders.LineStyle =xlLineStyleNone
End If
Next c
End with

---

it seems to work nicely but some is missing.

i dont want it to bold every cell, just the outter line of all rows that contain "artur" at collumn "a" and do nothing with the rest of the row.

the thing is i want it to do the same to all "Artur"s "Ariel"s "Jake"s rows.Attachment 15213

this is what it looks like when it works... only problem as i mentioned is if one of the preset names at collumn a are missing it fails.

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

Code:

---

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

---