(VBA) On Error GOTO, in a LOOP
(VBA) On Error GOTO, in a LOOP
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 7 of 7

Thread: (VBA) On Error GOTO, in a LOOP

  1. #1
    New Member
    Join Date
    Jun 2010
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Exclamation (VBA) On Error GOTO, in a LOOP

    Hi

    I wrote a Where_Used Maro that finds part numbers in Multilple tabs and puts the part number row onto a report tab. The issue is sometimes the part I'm looking for may not be in that Tab, so I added an "On Error GOTO ErrorHandler2" in my code so that it will skip to the next tab and start the looking process over again. The first time the macro runs the Error Handler work great, but when the Macro Loops to go on to the next tab and finds another Error the
    ErrorHandler2" dosen't work and I get a Run Time Error. I've been looking for the answer on Google.com, but I can find the answer. I've tried ERR.CLEAR and I can't use "ON Error Resume Next" because I'm working with multiple tabs and it would goof everything up. Dose anyone Know why VBA dose this and/or have a solution?
    Below is my code:

    Code:
    Sub Where_Used()
    '
    ' Where_Used Macro
        PartCount = 1
        Q_Total = 0
        Q_GrandTotal = 0
        Dim Bomnumber As Integer
        Dim PartNumber As String
        
    
    'Text Box where user can enter queried part number.
        a = InputBox("Enter Part Number You are looking for Below. Make sure it dose not contain any of these symbols : \ / ? * [ ]", "Text Box")
            If a = vbNullString Then
            MsgBox ("no value was entered, Please try again.")
            Exit Sub
        End If
        PartNumber = a
    'Text to tell Macro how many BOMs it is working with.
        Bomnumber = InputBox("Enter the number of BOMs I am working with.", "BOM")
        If Bomnumber = vbNullInteger Then
            MsgBox ("The number of BOMs was not entered, Please try again")
            Exit Sub
        End If
        BomNumberStart = Bomnumber
        Sheets(Bomnumber).Select
    
    ' Delete column B
        If Range("B1") = "NEXT ASMBLY" Then
            Range("B1:B65536").Select
            Selection.Delete shift:=xlToLeft
        End If
    'Stop Animation to increase the processing speed of the Macro.
        Application.ScreenUpdating = False
        
    'Name and color tabs.
        On Error GoTo ErrorHandler1
        
        Sheets.Add(after:=Sheets(Bomnumber)).Name = a
        ActiveSheet.Tab.Color = 5287936
        Sheets(Bomnumber).Select
        Cells(1, 1).Select
        FT = 1
        
    'Loop to count all the BOMs.
        
        
        
        Do Until Bomnumber = 0
    
            Sheets(Bomnumber).Select
            
            If Range("B1") = "NEXT ASMBLY" Then
            Range("B1:B65536").Select
            Selection.Delete shift:=xlToLeft
            End If
            
            y = 1
            x = 6
            
            Do Until x <= y
                If y <> 1 Then
                    Q_Total = Q_Total + Selection.Offset(0, 2)
                End If
    'Find each queried part number in the active BOM.
                If x = 6 Then
                  
                    On Error GoTo ErrorHandler2
                    Cells.Find(What:=PartNumber, after:=ActiveCell, LookIn:=xlFormulas, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate
                    Q_Total = Q_Total + Selection.Offset(0, 2)
                    x = ActiveCell.Row
                    d = ActiveCell.Row
                End If
                
                y = x
                 
                If x <> 1 Then
            
                    b = Selection.Offset(0, -2)
                    Range(Selection.Offset(0, -2), Selection.Offset(0, 2)).Select
                    Selection.Copy
                    Sheets(a).Select
                    ActiveSheet.Paste
                    
    'Finding all the upper level part numbers.
                    Do Until Range("A" & (ActiveCell.Row)) = 1
                        'Rows("1:1").Select
                        Range("A" & (ActiveCell.Row)).Select
                        Selection.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                        ActiveCell = d
                        Range(Selection, Selection.Offset(0, 5)).Select
                        Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        Sheets(Bomnumber).Select
                        Range("A" & (ActiveCell.Row)).Select
                        Do Until b > ActiveCell
                            Selection.Offset(-1, 0).Select
                        Loop
                        b = ActiveCell
                        FT = ActiveCell
                        d = ActiveCell.Row
                        Range(Selection, Selection.Offset(0, 4)).Select
                        Selection.Copy
                        Sheets(a).Select
            
                        ActiveSheet.Paste
                        Application.CutCopyMode = False
                    Loop
                    Range("A" & (ActiveCell.Row)).Select
                    Selection.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    ActiveCell = d
                    Range("A" & (ActiveCell.Row)).Select
                    Z = (ActiveCell.Row)
                    Do Until Cells(Z, 1) = ""
                        'Range("A100000").End(xlUp).Select
                        Cells(Z, 1).Select
                        Z = Z + 1
                    Loop
            
                    Z = Z + 2
                    Cells(Z, 1).Select
                    Sheets(Bomnumber).Select
                    Cells(x, 3).Select
                End If
                
                Cells.Find(What:=PartNumber, after:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate
                
                x = ActiveCell.Row
                d = ActiveCell.Row
            Loop
            
            Sheets(a).Select
            
    'Create the next level of BOMs.
            If Range("B1") <> "" Then
                Range("a1:f1").Select
                Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Sheets(Bomnumber).Select
            'Auto Formate
                Range("A1:E1").Select
                Selection.Copy
                Sheets(a).Select
                Range("B1").Select
                ActiveSheet.Paste
                Cells.EntireColumn.AutoFit
                Cells(1, 1) = "BOM Row #"
                Range("A1", "F1").Select
                With Selection.Font
                    .Bold = True
                    .Underline = True
                End With
                Range(Cells(1, 1), Cells(Z, 6)).Select
                Selection.EntireColumn.AutoFit
                With Selection
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                End With
            End If
            
            
    
            If Range("B1") = "" Then
                Range("A65536").End(xlUp).Select
                Do Until Selection = ""
                    Selection.Offset(-1, 0).Select
        Loop
               
    
                Selection.EntireColumn.AutoFit
                With Selection
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                End With
            End If
            
    'Find the last row on the work sheet and create a total quanity line.
            Range("A65536").End(xlUp).Select
            Selection.Offset(2, 4).Select
            Selection = Sheets(Bomnumber).Name & " Total Quantity for Part Number " & PartNumber
            Selection.Offset(0, 1).Select
            Selection = Q_Total
            Range(Selection, Selection.Offset(0, -1)).Select
            Selection.Font.Bold = True
            With Selection.Borders(xlLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With Selection.Borders(xlRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With Selection.Borders(xlTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With Selection.Borders(xlBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            
    'Creating the BOM Title.
            If Cells(1, 1) = "BOM Row #" Then
                Range("a1:f1").Select
                Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(1, 1).Select
                Selection = Sheets(Bomnumber).Name
                With Selection.Font
                    .Bold = True
                    .Color = -65536
                    .Italic = True
                    .Underline = True
                    .Size = 14
                End With
            End If
            
            Bomnumber = Bomnumber - 1
            
            If Bomnumber <> 0 Then
                
    PartNotFound:
                Range("E65536").End(xlUp).Select
                Selection.Offset(2, -4).Select
                Selection = Sheets(Bomnumber).Name
                With Selection.Font
                    .Bold = True
                    .Color = -65536
                    .Italic = True
                    .Underline = True
                    .Size = 14
                End With
                Selection.Offset(2, 0).Select
                FT = (ActiveCell.Row)
                
                If Range("A3") = "BOM Row #" Then
                    Range("A" & (ActiveCell.Row), "F" & (ActiveCell.Row)).Select
                    Range("A3", "F3").Copy
                    Range("A" & (ActiveCell.Row)).Select
                    ActiveSheet.Paste
                    Selection.Offset(1, 0).Select
                    Range("A" & (ActiveCell.Row)).Select
                    FT = (ActiveCell.Row)
                End If
            End If
            
            
            
            Q_GrandTotal = Q_GrandTotal + Q_Total
            Q_Total = 0
        Loop
        
    'Formating the quered part number with color and borders.
        Columns("D:D").Select
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:=a
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Font
            .Bold = True
            .Color = -65536
        End With
        With Selection.FormatConditions(1).Borders(xlLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.FormatConditions(1).Borders(xlRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.FormatConditions(1).Borders(xlTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.FormatConditions(1).Borders(xlBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Range("A1", "F50000").Select
        With Selection
            .EntireColumn.AutoFit
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
        
    'Creating a grand total line for all queried part numbers found in all BOMs.
        Range("E65536").End(xlUp).Select
        Selection.Offset(3, 0).Select
        Selection = "The Grand Total Quantity for Part Number " & PartNumber
        
        Range("D" & (ActiveCell.Row), "E" & (ActiveCell.Row)).Merge
        
        Selection.Offset(0, 1).Select
        Selection = Q_GrandTotal
        Range(Selection, Selection.Offset(0, -1)).Select
        Selection.Interior.Color = 65535
        With Selection.Font
            .Bold = True
            .Color = -65536
            .Size = 14
        End With
        With Selection.Borders(xlLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
        With Selection.Borders(xlRight)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
        With Selection.Borders(xlTop)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
        With Selection.Borders(xlBottom)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
        
    'Creating a header, a footer and adjusting the print area to one page wide.
        Header = "Where Used Report for Part Number " & a
        With ActiveSheet.PageSetup
            .CenterFooter = "GA.ASI Propietary Informaiton"
            .CenterHeader = "&""Arial,Bold Italic""&16""&U" & Header
            .LeftMargin = Application.InchesToPoints(0.7)
            .RightMargin = Application.InchesToPoints(0.7)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperLetter
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
            .EvenPage.LeftHeader.Text = ""
            .EvenPage.CenterHeader.Text = ""
            .EvenPage.RightHeader.Text = ""
            .EvenPage.LeftFooter.Text = ""
            .EvenPage.CenterFooter.Text = ""
            .EvenPage.RightFooter.Text = ""
            .FirstPage.LeftHeader.Text = ""
            .FirstPage.CenterHeader.Text = ""
            .FirstPage.RightHeader.Text = ""
            .FirstPage.LeftFooter.Text = ""
            .FirstPage.CenterFooter.Text = ""
            .FirstPage.RightFooter.Text = ""
        End With
        
        Cells(1, 1).Select
        Application.ScreenUpdating = True
        Exit Sub
        
    ErrorHandler1:
        
        ActiveSheet.Name = "Error Part " & PartCount
        a = "Error Part " & PartCount
        PartCount = PartCount + 1
        Resume Next
        
    ErrorHandler2:
        
        Sheets(a).Select
        
        If Bomnumber <> BomNumberStart Then
              Cells.Find(What:=Sheets(Bomnumber).Name, after:=ActiveCell, LookIn:=xlFormulas, _
              LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
              MatchCase:=False, SearchFormat:=False).Activate
            
              Range(ActiveCell, ActiveCell.Offset(2, 5)).Delete
        Else: BomNumberStart = BomNumberStart - 1
        End If
        
        Bomnumber = Bomnumber - 1
       
        GoTo PartNotFound
        
    End Sub
    Last edited by Von Pookie; Jun 9th, 2010 at 08:38 PM. Reason: Added code tags

  2. #2
    Board Regular
    Join Date
    Jun 2010
    Posts
    57
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: (VBA) On Error GOTO, in a LOOP

    I'm not sure I understand what you want to do.
    VBA recognise only the last On Error Statement.
    After On Error Statement , the first Error is catched by On Error and the second error make the program stop.
    Err.Clear erase this error count.
    Simplifying your code , the structure of your code is:
    Code:
    Sub Where_Used()
    'Name and color tabs.
        On Error GoTo ErrorHandler1        
    'Loop to count all the BOMs.    
        Do Until Bomnumber = 0
            Do Until x <= y
                If x = 6 Then
                    On Error GoTo ErrorHandler2
                End If
            Loop        
        Loop
    PartNotFound:    
        Exit Sub
    ErrorHandler1:
        Resume Next
    ErrorHandler2:
        GoTo PartNotFound
    End Sub
    Once after your code step reaches 'On Error GoTo ErrorHandler2',
    'On Error GoTo ErrorHandler1' is cancelled.
    Try this:
    Code:
    ErrorHandler2:
        On Error GoTo ErrorHandler1        
        GoTo PartNotFound
    End Sub

  3. #3
    New Member
    Join Date
    Jun 2010
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: (VBA) On Error GOTO, in a LOOP

    Thanks, it sounded like a good idea, but it didn't work. The run time error messege is still poping up the second time around.

  4. #4
    MrExcel MVP
    Moderator
    RoryA's Avatar
    Join Date
    May 2008
    Location
    UK
    Posts
    30,872
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: (VBA) On Error GOTO, in a LOOP

    You have to use a Resume statement in order to reset the error handler. You can Resume on your next label line and then add another On Error Goto line. Not great programming though, IMO.

  5. #5
    New Member
    Join Date
    Jun 2010
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: (VBA) On Error GOTO, in a LOOP

    But if I put in Resume or Resume next comand, it will take me back to where the error is occuring or the next line after the Error. I don't want it to go there, because the error is being caused because it can't find the part I'm looking for and with out the part number being there it will goof that whole section of the report. There has to be a way to rest the Error without forcing the code to go somewhere I don't want it to?
    thanks for the suggestion.

  6. #6
    New Member
    Join Date
    Jun 2010
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: (VBA) On Error GOTO, in a LOOP

    Thanks a lot rorya;

    Thatís not the way I wanted to correct the problem, but it works. What I did was copy all the code in the Macro that I needed before my report was ready to go to the resume point and pasted it below in the ErrorHander2, with a few tweaks and it works perfect now.

    I just wish the programmers of VAB would have included the Trap/Catch feature like in VB, I find it much more efficient than this "On Error GOTO" feature.

  7. #7
    Board Regular
    Join Date
    Jun 2010
    Posts
    57
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: (VBA) On Error GOTO, in a LOOP

    ††
    Ok , I'm sorry , I forget clearing the error.
    Could you rry this? :
    Code:
    ErrorHandler2:
        On Error GoTo ErrorHandler1        
        Resume PartNotFound
    End Sub
    or
    Code:
    ErrorHandler2:
        Err.Clear
        On Error GoTo ErrorHandler1        
        GoTo PartNotFound
    End Sub

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

DMCA.com