Multiple on error goto statements

[MrSak87]

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

''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

 

[RoryA]

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:

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:

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.

 

[MrSak87]

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]

Well spotted - I've corrected the code for posterity.