Email sheets macro errors if no sheets match

[BPSJACK]

Hi,

I'm using a macro which looks for sheets in a workbook with a specific name and emails the sheets to a recipient.

However, if the macro fails to find a matching sheet - the code will error.
Does anyone know how it might be modified to skip running the macro if none are found

Here's the code:

Sub EmailHearnNC()
ContinueEmail:
Application.DisplayAlerts = False
  '1 All
Dim sh, arr() As Variant
Dim bDim As Boolean: bDim = False

For Each sh In Array("61")
    If Evaluate("=ISREF('" & sh & "'!A1)") Then
        If bDim = False Then
            ReDim arr(0 To 0) As Variant
            arr(0) = sh
            bDim = True
        Else
            ReDim Preserve arr(0 To UBound(arr) + 1) As Variant
            arr(UBound(arr)) = sh
        End If
    End If
Next sh

Sheets(arr).Select
Sheets(arr).Copy

ChDir "U:\"
ActiveWorkbook.SaveAs Filename:="U:\testfile.xlsx", FileFormat:=51
ActiveWorkbook.SendMail Recipients:= _
Array("test@test.com"), _
Subject:="test" & Eom
ActiveWorkbook.Saved = True
ActiveWorkbook.Close

Dim myVal
On Error Resume Next
Set QueryOutlook = GetObject(, "Outlook.Application")
If Err <> 0 Then
myVal = Shell("C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE\OUTLOOK.EXE", 1)
Exit Sub
Else
End If

End Sub

In this example the code will error at "Sheets(arr).Select".

If anyone can offer any advice it would be much appreciated!
Thanks.

[Kaper]

May be just add checking if anything found?

Dim there_were_sheets as boolean

'...

there_were_sheets = False
For Each sh In Array("61")
    If Evaluate("=ISREF('" & sh & "'!A1)") Then
        there_were_sheets = True
        If bDim = False Then
'...
        End If
   End If
Next sh

If there_were_sheets Then
  Sheets(arr).Select
  Sheets(arr).Copy

'...

Else
  MsgBox "Nothing to send!", vbCritical, "Sorry"
End If

[brokenbiscuits]

Sub EmailHearnNC()
ContinueEmail:
Application.DisplayAlerts = False
  '1 All
Dim sh, arr() As Variant
Dim bDim As Boolean: bDim = False

x=0
For Each sh In Array("61")
    If Evaluate("=ISREF('" & sh & "'!A1)") Then
        x=1
        If bDim = False Then
            ReDim arr(0 To 0) As Variant
            arr(0) = sh
            bDim = True
        Else
            ReDim Preserve arr(0 To UBound(arr) + 1) As Variant
            arr(UBound(arr)) = sh
        End If
    End If
Next sh

if x=0 then
     msgbox "Sheet not found"
     Exit sub
endif
Sheets(arr).Select
Sheets(arr).Copy

ChDir "U:\"
ActiveWorkbook.SaveAs Filename:="U:\testfile.xlsx", FileFormat:=51
ActiveWorkbook.SendMail Recipients:= _
Array("test@test.com"), _
Subject:="test" & Eom
ActiveWorkbook.Saved = True
ActiveWorkbook.Close

Dim myVal
On Error Resume Next
Set QueryOutlook = GetObject(, "Outlook.Application")
If Err <> 0 Then
myVal = Shell("C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE\OUTLOOK.EXE", 1)
Exit Sub
Else
End If

End Sub

[BPSJACK]

Thanks guys!

brokenbiscuits I copied and pasted that sub directly and it worked perfectly

Thanks again.