Multiple on error goto statements

MrSak87

New Member
Joined
Jan 8, 2015
Messages
44
Hi all,

I've found various threads on problems similar to the one I'm having but none of them appear to be working for me.

All I'm trying to do is copy and paste various results from one excel sheet to another - the macro is really simple and works fine. The only problem is that in some instances some tests have not been performed so an error message will pop up (I'm using the find function and if it's not there I get the error). The obvious solution would be "On Error Goto Err1:" and then have "Err1" where it wants to resume. The problem is this only works once. I've also tried the Err.clear function but that seems to fail too. Here is a section of my code
Code:
''Moisture
    SrcWB.Activate
    On Error GoTo Err1
    Cells.Find(What:="*LNMC_LNMC", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
        Selection.Offset(2).Select
    Range(Selection, Selection.End(xlDown)).Copy
    
    ''Paste in
    DestWB.Worksheets("Sheet1").Activate
    Range("n2").Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Err1:


    ''Moisture & density
    SrcWB.Activate
    On Error GoTo Err2:
    Cells.Find(What:="*LDEN_MC", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
        Selection.Offset(2).Select
    Range(Selection, Selection.End(xlDown)).Copy
    
    ''Paste in
    DestWB.Worksheets("Sheet1").Activate
    Range("o2").Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Err2:
    
''Bulk Density
    SrcWB.Activate
    On Error GoTo Err3:
    Err.Clear
    Cells.Find(What:="*BDEN_BDEN", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
                
        Selection.Offset(2).Select
    Range(Selection, Selection.End(xlDown)).Copy


    ''Paste in
    DestWB.Worksheets("Sheet1").Activate
    Range("P2").Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Err3:
What am I missing!?

Thank you for any help.
Cheers
 
Last edited by a moderator:

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,178
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
You would need a Resume statement to clear the current exception: On Error WTF? | Excel Matters

However, you don't really need an error handler here at all - you can simply avoid the error altogether. Instead of this, which will raise an error if the value is not found:
Code:
On Error GoTo Err1
Cells.Find(What:="*LNMC_LNMC", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.Offset(2).Select
Range(Selection, Selection.End(xlDown)).Copy

''Paste in
DestWB.Worksheets("Sheet1").Activate
Range("n2").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
You should assign the result of the Find to a Range variable and test if that's Nothing:
Code:
Dim rngFound as Range
Set rngFound = Cells.Find(What:="*LNMC_LNMC", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If not rngFound is Nothing then
rngFound.Offset(2).Select
Range(Selection, Selection.End(xlDown)).Copy Destination:=DestWB.Worksheets("Sheet1").Range("n2")
End If
and repeat for the other sections.
 
Last edited:

MrSak87

New Member
Joined
Jan 8, 2015
Messages
44
Cheers man works perfectly!! you just had a little spelling mistake in destination which threw me.

You've saved me loads of time - nice one!
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
34,178
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
Well spotted - I've corrected the code for posterity. :)
 

Forum statistics

Threads
1,078,253
Messages
5,339,111
Members
399,279
Latest member
danidanidaniel

Some videos you may like

This Week's Hot Topics

Top