Macro to exit sub if sheet not found

[howard]

I have written code to email a sheet, but if the sheet does not exist, then Message box to advise "Sheet does not exist as no data available" and then to exit sub, but if sheet exits then to continue


It would be apprciated if someone could kindly amend my code

Sub Email_BR1()

Dim File As String, strBody As String, ws As Worksheet
On Error Resume Next
Set ws = Sheets("MySheet")



Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Err.Number <> 0 Then
MsgBox "There are no overdue amounts for this branch, hence there is no sheet "
Else
File = Environ$("temp") & "\" & Format(Range("Q2"), "mmm-yy ") & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx"
strBody = "Hi " & Sheets("BR1").Range("U1") & vbNewLine & vbNewLine & _
"Attached, please find overdue amounts." & vbNewLine & vbNewLine & _
"The total overdue balance is " & Format(Sheets("BR1").Range("P1"), "R#,##0.00") & "." & vbNewLine & vbNewLine & _
"Regards" & vbNewLine & vbNewLine & _
"Howard"
ActiveWorkbook.Save

Sheets("BR1").Copy
With ActiveWorkbook
.SaveAs Filename:=File, FileFormat:=51
.Close savechanges:=False
End With
With CreateObject("Outlook.Application").CreateItem(0)
.Display
.to = Join(Application.Transpose(Sheets("BR1").Range("V1:V2").Value), ";")
.Subject = "overdue Debtors"
.body = strBody
.Attachments.Add File
'.Send
End With
End If
Kill File
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub [code]

 

[dmt32]

Hi,
try this update to your code & see if does what you want

Sub Email_BR1()
    
    Dim File As String, strBody As String
    Dim ws As Worksheet, wsBR1 As Worksheet
    
    On Error Resume Next
    Set wsBR1 = Worksheets("BR1")
    
    On Error GoTo myerror
    If wsBR1 Is Nothing Then Err.Raise 9, , "Sheet BR1 Missing"

    Set ws = Sheets("MySheet")
    
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Err.Number <> 0 Then
        MsgBox "There are no overdue amounts for this branch, hence there is no sheet "
    Else
        File = Environ$("temp") & "\" & Format(Range("Q2"), "mmm-yy ") & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx"
        strBody = "Hi " & wsBR1.Range("U1") & vbNewLine & vbNewLine & _
        "Attached, please find overdue amounts." & vbNewLine & vbNewLine & _
        "The total overdue balance is " & Format(wsBR1.Range("P1"), "R#,##0.00") & "." & vbNewLine & vbNewLine & _
        "Regards" & vbNewLine & vbNewLine & _
        "Howard"
        ActiveWorkbook.Save
        
        wsBR1.Copy
        With ActiveWorkbook
            .SaveAs FileName:=File, FileFormat:=51
            .Close savechanges:=False
        End With
        With CreateObject("Outlook.Application").CreateItem(0)
            .Display
            .to = Join(Application.Transpose(Sheets("BR1").Range("V1:V2").Value), ";")
            .Subject = "overdue Debtors"
            .body = strBody
            .Attachments.Add File
'.Send
        End With
    End If
    Kill File
    
myerror:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

 

[howard]

Thanks for the help Dasve

Ehen running the macro, I now get "subscript out of range"

I have posted the link from dropbox below

kindly test & amend code


Email Exit Sub where sheets missing.xlsm

 

[dmt32]

Thanks for the help Dasve

Ehen running the macro, I now get "subscript out of range"

You get the error because of this line

Set ws = Sheets("MySheet")

I cannot see it doing anything in your code & sheet does not exist in your workbook - if line of code not needed, then delete it

Dave

 

[howard]

Thanks For yoyr Input Dave. I have removed Set ws = Sheets("MySheet") and code now runs perfectly

I should have noticed this when checking the code

 

[dmt32]

most welcome - glad resolved

Dave

 

[howard]

Hi Dave

I would like to amend the code so that if sheet exists, but cell A2 on the particular sheet is blank, then Exit sub

I tried to amend the code as follows , but cannot get it to work

If Err.Number <> 0 Or ws1.Range("a2") = """" Then Kindly test & amend

 

[MARK858]

Try removing 2 of the quotes

 

[dmt32]

Hi Dave

I would like to amend the code so that if sheet exists, but cell A2 on the particular sheet is blank, then Exit sub

Try adding line of code below where shown & see if does what you want

Sub Email_BR1()
    
    Dim File As String, strBody As String
    Dim ws As Worksheet, wsBR1 As Worksheet
    
    On Error Resume Next
    Set wsBR1 = Worksheets("BR1")
    
    On Error GoTo myerror
    If wsBR1 Is Nothing Then Err.Raise 9, , "Sheet BR1 Missing"
    
    If Len(wsBR1.Range("A2").Value) = 0 Then Exit Sub

'rest of code

Dave

 

[howard]

thanks Dave it works perfectly