(VBA) On Error GOTO, in a LOOP

[bigj2222]

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:

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

 

[Akihito Yamashiro]

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:

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:

ErrorHandler2:
    On Error GoTo ErrorHandler1        
    GoTo PartNotFound
End Sub

 

[bigj2222]

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.

 

[RoryA]

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.

 

[bigj2222]

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.

 

[bigj2222]

Thanks a lot rorya;<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
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. <o></o>
<o></o>
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.<o></o>

 

[Akihito Yamashiro]

Ok , I'm sorry , I forget clearing the error.
Could you rry this? :

ErrorHandler2:
    On Error GoTo ErrorHandler1        
    Resume PartNotFound
End Sub

or

ErrorHandler2:
    Err.Clear
    On Error GoTo ErrorHandler1        
    GoTo PartNotFound
End Sub