If cell value Send, else Display

[Ruca13]

Hello everyone,

I have a code to send an e-mail, adapted from the one found in rondebruin page, and it works almost perfectly.

The thing is, I have a cell where I write Yes or No, which answer if I want to send the e-mail automatically.

But inside the code, it is not working:

            If Worksheets("Settings").Cells(1, 5).Text = "No" Then
            .Display
            Else
            .Send
            End If

I've tried on a different module, replacing the display and send with msgboxes and the if is reading the correct information, but for some reason, on the whole code, it only reads the first that appears (I've tried to change the order of the if conditions and it sends the email disregarding what's written on the cell).

Here's the whole code:

Sub Mail_single()


'Only for the suppliers that are to be contacted by e-mail
If Cells(ActiveCell.Row, 7) <> "Email" Then
MsgBox ("Please select the proper way to contact supplier")
Exit Sub
Else
End If


If Cells(ActiveCell.Row, 6) = 0 Then
MsgBox ("Please select a supplier with pending claims")
Exit Sub
Else
End If


Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = False


    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
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
      
    Dim sup As Range
    Set sup = ActiveCell
            
    Sheets("Claim Master").Activate
    Dim Claims As Workbook
    Set Claims = ThisWorkbook
    
'Create a temporary sheet with the filtered data
If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
    Else
    End If
       
    ActiveSheet.Cells.EntireColumn.Hidden = False
    ActiveSheet.Cells.EntireRow.Hidden = False


Cells(3, 1).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
        
ActiveSheet.Range(Cells(3, 1), Cells(2000, 20)).AutoFilter Field:=11, Criteria1:="Disputed"
   
ActiveSheet.Range(Cells(3, 1), Cells(2000, 20)).AutoFilter Field:=8, Criteria1:=sup.Text


Application.CutCopyMode = False


Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Disputed Claims"


Dim LR As Long, LC As Long
LR = Sheets("Claim Master").Cells(1, 1).End(xlDown).Row
LC = Sheets("Claim Master").Cells(3, 1).End(xlToRight).Column


Sheets("Claim Master").Activate
ActiveSheet.Range(Cells(1, 1), Cells(LR, LC)).Copy
Sheets("Disputed Claims").Activate


Sheets("Disputed Claims").Paste


Worksheets("Claim Master").Columns(20).Copy


Worksheets("Disputed Claims").Columns(20).PasteSpecial Paste:=xlPasteFormulas


'Format attachment
Columns(15).Select
    Selection.ColumnWidth = 28


Application.CutCopyMode = False


Columns(11).EntireColumn.Delete
Columns(8).EntireColumn.Delete


Columns(2).Delete


Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Cells(1, 1) = "Pending Claims"
    Cells(1, 1).Select
    Selection.Font.Size = 18
    
    Columns(1).EntireColumn.AutoFit
    Rows(1).RowHeight = 37
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Cells(1, 2) = sup.Value
    
    Cells(1, 1).Copy
    Cells(1, 2).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Rows(2).Delete
    Rows(2).Delete
    
Cells.Select
    Cells.EntireColumn.AutoFit
   Cells.EntireRow.AutoFit
    
Cells(1, 1).Select
Application.CutCopyMode = False


'This creates the attachment
Sheets("Disputed Claims").Copy


Set Sourcewb = ActiveWorkbook
    Set Destwb = ActiveWorkbook
     
      ' Determine the Excel version, and file extension and format.
    With Destwb
                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 With
     
    Dim mysheet As Worksheet, lp As Long, PrevCalc As Variant
  
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Disputed Claims " & sup.Value & " " & Format(Now, "dd-mmm-yy")


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    row_number = sup.Row
    Dim mail_mail_body_message As String
    Dim full_name As String
    Dim contact As String
    contact = Claims.Sheets("Settings").Cells(row_number, 3)
    mail_body_message = Claims.Sheets("Settings").Cells(row_number, 8)
            
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = contact
            .CC = ""
            .BCC = ""
            .Subject = TempFileName
            .Body = mail_body_message
            .Attachments.Add Destwb.FullName
            If Worksheets("Settings").Cells(1, 5).Text = "No" Then
            .Display
            Else
            .Send
            End If
        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.DisplayFormulaBar = True
    With ActiveWindow
        .DisplayGridlines = True
    End With
         
    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
    Else
    End If
    ActiveSheet.Cells.EntireColumn.Hidden = False
    ActiveSheet.Cells.EntireRow.Hidden = False
    
    Application.CutCopyMode = False


Sheets("Claim Master").Activate


    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
    Else
    End If


Sheets("Disputed Claims").Delete
      
    Sheets("Settings").Activate
    
    ActiveSheet.Cells.EntireRow.Hidden = False
    Application.ScreenUpdating = True
        
End Sub

 

[FormR]

Hi, you could try temporarily commenting out or removing the "On Error Resume Next" line to see if it is masking the problem.

 

[Ruca13]

Thanks, I had there for so long did even noticed it. I was able to find the problem.

The sheet i was referring in the if did not exist in the attachment, and all i needed was to reference the workbook of that sheet before.

Thank you for your advice, I'll try to keep it in mind since it's extremely useful.

 

[FormR]

The sheet i was referring in the if did not exist in the attachment, and all i needed was to reference the workbook of that sheet before.

Cool, I did wonder if that was the problem - did you end up changing the IF line to:

If Claims.Worksheets("Settings").Cells(1, 5).Text = "No" Then

 

[Ruca13]

Exactly like that.