CODEWITHSUNDEEP
excelvba
Deke
Deke

Reputation: 495

VBA Error Handling setting up Go to Specific Line or Label?

I'm trying to figure out the best way to handle a situation where I could have an error pop and if it does I would like the code to skip to either a specific line in the code or a label. I've tried a few things but seems I'm having an issues. Either full on Excel crash when running it or my on error goto <label> being ignored.

I'm attempting to do this for 4 different instances of errors and I contemplated using Functions but I'm not sure they will do what I want since this is if there is an error and if there is no error then it wouldn't run the function and thus skip the code entirely.

I should also mention the error is that when a filtered criteria is blank/Empty, thus nothing in the cells, my "Add break" code errors that there are no cells to go through.

Any suggestions or help would be greatly appreciated!

Thanks!!!

Here is what I'm working with:

On Error GoTo ErrSkip1:
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("A1:O" & lr).AutoFilter Field:=12, Criteria1:="Item Merch Change"
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add(Range( _
"A2:A" & lr), xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(153, 204, 0)
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Add Break
Set rng = Range("A2:A" & lr).SpecialCells(xlCellTypeVisible)
    irow = rng.Row
    icol = rng.Column
Do
If Cells(irow + 1, icol).Font.ColorIndex <> Cells(irow, icol).Font.ColorIndex Then
   Cells(irow + 1, icol).EntireRow.Insert shift:=xlDown
   Cells(irow + 1, icol).EntireRow.ClearFormats
   irow = irow + 2
Else
   irow = irow + 1
End If
'
Loop While Not Cells(irow, icol).Text = ""

ErrSkip1:
    Range("A2").Select
    ActiveSheet.ShowAllData

'Format and sort RD Changes
On Error GoTo ErrSkip2
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("A1:O" & lr).AutoFilter Field:=12, Criteria1:="RD Change"
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add(Range( _
"A2:A" & lr), xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(153, 204, 0)
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Add Break
Set rng = Range("A2:A" & lr).SpecialCells(xlCellTypeVisible)
    irow = rng.Row
    icol = rng.Column
Do
If Cells(irow + 1, icol).Font.ColorIndex <> Cells(irow, icol).Font.ColorIndex Then
   Cells(irow + 1, icol).EntireRow.Insert shift:=xlDown
   Cells(irow + 1, icol).EntireRow.ClearFormats
   irow = irow + 2
Else
   irow = irow + 1
End If
'
Loop While Not Cells(irow, icol).Text = ""

ErrSkip2:
  Range("A2").Select
  ActiveSheet.ShowAllData

Upvotes: 0

Views: 1917

Answers (1)

Tim Williams
Tim Williams

Reputation: 166256

If your problem is this line:

Set rng = Range("A2:A" & lr).SpecialCells(xlCellTypeVisible)

and it's reasonable to predict there may be times when all rows are filtered out, then it would be better to do something like this:

Set rng = Nothing 'if rng may already have been assigned
On Error Resume Next
Set rng = Range("A2:A" & lr).SpecialCells(xlCellTypeVisible)
On Error Goto 0

If Not rng is nothing then
    'work with rng
Else
    'no visible rows...
End if

...and if this is a common task then you can simplify your code by splitting it out into a Function

Function VisibleCells(rngIn as Range) As Range
    Dim rv As Range
    On Error Resume Next
    Set rng = rngIn.SpecialCells(xlCellTypeVisible)
    On Error Goto 0
    Set VisibleCells = rv
End Function

Upvotes: 2

Related Questions