On error goto while looping

[vasek1192]

Hello, I am currently in process of learning the VBA so please be gentle :D I have problem with "On error goto" statement inside looping. The aim is to categorize the movies on their length, create the sheet, name it after the category and copy the movies within the category to the new sheet. The first

"On Error GoTo Short1" works fine, but the second goto statement "On Error GoTo Medium1" fails to activate. Any suggestions? Thanks.

Code:​

Sub SimpleLoopIf()
    Dim FilmLength As Integer
    Dim FilmRating As String
    
    
    Worksheets("Movie List").Activate
    Range("A3").Select
    
    GoTo 4
  
Short1:
    Worksheets.Add
            ActiveSheet.Name = "Short"
            GoTo 4
Medium1:
    Worksheets.Add
            ActiveSheet.Name = "Medium"
            GoTo 4
Long1:
    Worksheets.Add
            ActiveSheet.Name = "Long"
            GoTo 4
4:
    Do
        FilmLength = ActiveCell.Offset(0, 3).Value
        
        If FilmLength < 100 Then
            FilmRating = "Short"
            On Error GoTo Short1
            Worksheets("Short").Activate
            Worksheets("Movie List").Activate
        ElseIf FilmLength < 150 Then
            FilmRating = "Medium"
            On Error GoTo Medium1
            Worksheets("Medium").Activate
            Worksheets("Movie List").Activate
        Else
            FilmRating = "Long"
            On Error GoTo Long1
            Worksheets("Long").Activate
            Worksheets("Movie List").Activate
        End If
        
        Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
        Worksheets(FilmRating).Activate
        
        ActiveCell.PasteSpecial
        ActiveCell.Offset(1, 0).Select
        Worksheets("Movie List").Activate
        
        ActiveCell.Offset(0, 4).Value = FilmRating
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Value = ""
   
End Sub

 

[BobUmlas]

It seems like you might be trying to add 2 (or more) sheets with the same name, and get stuck in a loop due to the on error sending you to the same place adding a worksheet with a name that already exists. You didn't say what's actually happening. Saying it fails to activate doesn't help much. What happens?

 

[Fluff]

VBA can only handle one error at a time, have a look here

On Error WTF?

One of the more frequent questions I come across relates to the situation where an active and enabled error handler section handles the first error as expected but then fails to handle any subseque…

excelmatters.com

 

[Fluff]

You can get rid of the error handling like

Sub SimpleLoopIf()
    Dim FilmLength As Integer
    Dim FilmRating As String
    
    
    Worksheets("Movie List").Activate
    Range("A3").Select
    
    Do
        FilmLength = ActiveCell.Offset(0, 3).Value
        
        If FilmLength < 100 Then
            FilmRating = "Short"
            If Not Evaluate("isref(Short!A1)") Then
               Worksheets.Add.Name = "Short"
            End If
            Worksheets("Movie List").Activate
        ElseIf FilmLength < 150 Then
            FilmRating = "Medium"
            If Not Evaluate("isref(Medium!A1)") Then
               Worksheets.Add.Name = "Medium"
            End If
            Worksheets("Movie List").Activate
        Else
            FilmRating = "Long"
            If Not Evaluate("isref(Long!A1)") Then
               Worksheets.Add.Name = "Long"
            End If
            Worksheets("Movie List").Activate
        End If
        
        Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
        Worksheets(FilmRating).Activate
        
        ActiveCell.PasteSpecial
        ActiveCell.Offset(1, 0).Select
        Worksheets("Movie List").Activate
        
        ActiveCell.Offset(0, 4).Value = FilmRating
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Value = ""
   
End Sub

 

[xenou]

In general you don't want to use error handling for control logic (i.e., for things that can be done with If/Then, While/Loop). And you don't want to use GoTo except to go to an error catch. Save the error handling for actually catching unexpected errors. Try to write code that works even without the error catching (i.e., code that doesn't error). There are some simple cases that are common exceptions - not relevant here.

 

[dmt32]

Hi,
untested but see if this approach does what you want

Sub SimpleLoop()
    Dim FilmLength As Integer
    Dim wsMovieList As Worksheet
    Dim FilmRating As Variant
    Dim FilterRange As Range
    
    Set wsMovieList = ThisWorkbook.Worksheets("Movie List")
    
    For Each FilmRating In Array("Short", "Medium", "Long")
    'check if sheet exists
        If Not Evaluate("ISREF('" & FilmRating & "'!A1)") Then
            Worksheets.Add.Name = FilmRating
        End If
        FilmLength = FilmLength + 1
        With wsMovieList
            .Range("$A$2:$D$" & .Range("D" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=4, _
                Criteria1:=">=" & Choose(FilmLength, 0, 100, 150), _
                Operator:=xlAnd, _
                Criteria2:="<=" & Choose(FilmLength, 100, 150, 400)
        Set FilterRange = .AutoFilter.Range
        FilterRange.SpecialCells(xlCellTypeVisible).Copy Worksheets(FilmRating).Range("A1")
             .Range("A1").AutoFilter
        End With
    Set FilterRange = Nothing
    Next FilmRating
    
End Sub

Dave

 

[vasek1192]

It seems like you might be trying to add 2 (or more) sheets with the same name, and get stuck in a loop due to the on error sending you to the same place adding a worksheet with a name that already exists. You didn't say what's actually happening. Saying it fails to activate doesn't help much. What happens?

Hi, thanks for the reply. What i meant was that goto failed to activate the appropriate code line (medium1). I know what was the error now. I did not know I cant use more than one on error statements with goto.

 

[vasek1192]

You can get rid of the error handling like

Sub SimpleLoopIf()
    Dim FilmLength As Integer
    Dim FilmRating As String
   
   
    Worksheets("Movie List").Activate
    Range("A3").Select
   
    Do
        FilmLength = ActiveCell.Offset(0, 3).Value
       
        If FilmLength < 100 Then
            FilmRating = "Short"
            If Not Evaluate("isref(Short!A1)") Then
               Worksheets.Add.Name = "Short"
            End If
            Worksheets("Movie List").Activate
        ElseIf FilmLength < 150 Then
            FilmRating = "Medium"
            If Not Evaluate("isref(Medium!A1)") Then
               Worksheets.Add.Name = "Medium"
            End If
            Worksheets("Movie List").Activate
        Else
            FilmRating = "Long"
            If Not Evaluate("isref(Long!A1)") Then
               Worksheets.Add.Name = "Long"
            End If
            Worksheets("Movie List").Activate
        End If
       
        Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
        Worksheets(FilmRating).Activate
       
        ActiveCell.PasteSpecial
        ActiveCell.Offset(1, 0).Select
        Worksheets("Movie List").Activate
       
        ActiveCell.Offset(0, 4).Value = FilmRating
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Value = ""
  
End Sub

Thanks, it worked perfectly. I did not know the "evaluate("isref….")" statement

 

[Fluff]

Glad we could help & thanks for the feedback.