Macro to email sheet if D21 if not zero

howard

Well-known Member
Joined
Jun 26, 2006
Messages
6,561
Office Version
  1. 2021
Platform
  1. Windows
I have written code to generate an email if cell D21 in not zero eg 50, 0.05, -58.35 etc

If zero then macro to exit

I have tried to write the code, but if D21 is zero, macro is still created

Code:
 Sub Email_BR1()
With Sheets("BR1")
If Range("D21").Value <> 0 Then
Exit Sub
End If
End With


Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim Stringbody As String


With Application
.ScreenUpdating = False
.EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook




    'Copy the ActiveSheet to a new workbook
Sheets("BR1").Copy
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
    End With

    'Change all cells in the worksheet to values if you want

With Sheets(1).UsedRange
.Value = .Value
End With


        Application.CutCopyMode = False




    'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
    TempFileName = "" & Sourcewb.Sheets(1).Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
            .To = Range("L1:L1")

            .CC = ""
.BCC = ""
.Subject = "Sales Ledger variance"
strBody = strBody & "Hi " & Range("K1").Value & vbNewLine & vbNewLine
strBody = strBody & "Attached, please find BR1 Sales Ledger Variances." & vbNewLine & vbNewLine


strBody = strBody & "Regards" & vbNewLine & vbNewLine
           strBody = strBody & "Howard"

            .Body = strBody
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.display 'Use .send to send automatically or .Display to check email before sending
End With
On Error GoTo 0
.Close savechanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


End Sub

Your assistance regard the above is most appreciated
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Forum statistics

Threads
1,213,561
Messages
6,114,312
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top