Macro to activate message if cell D1 is zero

[Howardc1001]

I have a macro to email a sheet with a message , which works fine



However, should cell D1 be zero, then sheet must not be attached, an message in body of email to state

"strBody = "Hi " & Sheets("BR1").Range("S1") "& please check your debtors ageing and hand over your problematic debtors for collection" & vbNewLine & vbNewLine &

 Sub Email_report()

Dim File As String, strBody As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
File = Environ$("temp") & "\" & Format(Range("Q2"), "mmm-yy ") & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx"
strBody = "Hi " & Sheets("BR1").Range("S1") & vbNewLine & vbNewLine & _
          "Attached, please find " & Sheets("BR1").Range("A1") & vbNewLine & vbNewLine & _
            "Please check attend to your slow paying debtors" & 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("R2:R5").Value), ";")
    .Subject = Sheets("Br1").Range("A1")
    .body = strBody
    .Attachments.Add File
    '.Send
End With
Kill File
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

I have attached sample data

Your assistance in this regard is most appreciated

[davesexcel]

You can add an if statement

Sub Email_report()

Dim File As String, strBody As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
File = Environ$("temp") & "\" & Format(Range("Q2"), "mmm-yy ") & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx"
strBody = "Hi " & Sheets("BR1").Range("S1") & vbNewLine & vbNewLine & _
          "Attached, please find " & Sheets("BR1").Range("A1") & vbNewLine & vbNewLine & _
            "Please check attend to your slow paying debtors" & 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("R2:R5").Value), ";")
    .Subject = Sheets("Br1").Range("A1")
    .body = strBody
    If Range("D1").Value <> 0 Then
    .Attachments.Add File
    End If
    '.Send
End With
Kill File
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

[Howardc1001]

thanks for the help Dave. If the value in D1 is zero, how do I amend message so that only the message below displays in the body ?
If <> 0 then current message to display in body

[Howardc1001]

Hi Dave

I tried to amend the code so that if D1 = zero, then the applicable sheet is not to be attached and strbody1 message to appear in body

When running the macro Email BR1 where D1 = 0 , the applicable sheet is attached and strbody1 does not appear in the body-strbody message appears



Kindly check & amend my code


Your assistance is most appreciated

 Sub Email_BR2()


Dim File As String, strBody As String, strBody1 As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
File = Environ$("temp") & "\" & Format(Range("Q2"), "mmm-yy ") & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx"
strBody = "Hi " & Sheets("BR2").Range("S1") & vbNewLine & vbNewLine & _
          "Attached, please find " & Sheets("BR2").Range("A1") & vbNewLine & vbNewLine & _
            "Please check attend to your slow paying debtors" & vbNewLine & vbNewLine & _
             "Regards" & vbNewLine & vbNewLine & _
            "Howard"
      strBody1 = "Hi " & Sheets("BR2").Range("S2") & vbNewLine & vbNewLine & _
           "Attached, please find " & Sheets("BR2").Range("A1") & vbNewLine & vbNewLine & _
            "Please check your probematic and transfer to suspect debtors and hand these over if neccesary" & vbNewLine & vbNewLine & _
             "Regards" & vbNewLine & vbNewLine & _
            "Howard"
                          
ActiveWorkbook.Save

Sheets("BR2").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("BR2").Range("R2:R5").Value), ";")
    .Subject = Sheets("BR2").Range("A1")
    
    .to = Sheets("BR2").Range("R2:R2").Value
     If Range("D1").Value <> 0 Then
    .body = strBody
    Else
     .body = strBody1
     End If
      If Range("D1").Value <> 0 Then
    .Attachments.Add File
    End If
    '.Send
    End With
     
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

[bakerman2]

Are you sure you are on the correct sheet, because the code in itself works just fine.

[Howardc1001]

Hi Bakerman2

Thanks for the reply.
Sub Email_BR1() works fine as the value in D1 on sheet("Br1") <> 0

however, Sub Email_BR2() , pertaining to sheet("Br2"), where the value in D1 = 0, there should be no attachment and the message in the body should pertaining to strbody1 and NOT STRbody

Kind test and amend code

[bakerman2]

Specify the sheet for range D1 so Sheets("BR2").Range("D1").value.

[Howardc1001]

Thanks, I realised that on checking my code

[Howardc1001]

I see where my problem is


I need to refer to the sheet on my macro, otherwise If I am not on the activate sheet macro does not work correctly

[bakerman2]

You're welcome.