PDA

View Full Version : Run-time error "91":



shazamy
01-19-2016, 03:19 AM
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:



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

SamT
01-19-2016, 04:30 AM
Try this
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

shazamy
01-19-2016, 05:49 AM
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.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.

SamT
01-19-2016, 07:04 AM
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