Private Sub Worksheet_Calculate() - Not running when workbook opens

[mykal66]

Hi.

I've set up a simple spread sheet (just 6 columns) to automatically monitor when a reminder needs to be sent to a manager. I struggled with one issue yesterday which a member of the forum helped me with but I now have another issue I cant' figure out.

Column F works out how many days until a review is due automatically using the NOW() function which works fine. I wanted the macro to run automatically when the workbook was opened each day and if any of the values showed 14 send a basic email to advise a manager to book a review. This works perfectly if I manually change any of the values in column F to 14 but even if the value changes to 14 automatically when the workbook is opened it will not auto send the email.

I tried changing the macro to Worksheet Open() too but no joy. I have also tried attaching the macro to a command button to manually trigger it after the workbook is open but his then just finds issues elsewhere in the code.

Is there something I am doing wrong or is it not possible to trigger the macro on open to check if any of the values are 14 and send emails?

The workbook is attached and if you enter 14 into column F you can get the jist of what I was hoping would be automatic when the book was opened each day - I am happy to attach the macro to a button too if need be.

Always appreciate the help you guys give

Thanks

[jonh]

Well I don't know about Mail_with_outlook2 but Worksheet_Calculate seems to work here.

Type stop at the begining of the procedures.

Private Sub Worksheet_Calculate()
stop
...

Sub Mail_with_outlook2()
stop
...

Save. Close. Reopen.

If the code stops at the first Stop it is running. Press f5.
If the code stops at the second Stop it's doing the email thing. Press f8 until you find the error.

[Bob Phillips]

The essence of your problem is your formula, because you use NOW() you get the time deducted as well, so it will never be 14.

In addition, testing for E4>(1/1/1999) is not testing for greater than 1st Jan 1999, it is testing for greater than 1 divided by 1 divided by 1999, a very small number.

Your formula would better read as

=IFERROR(IF(E6>--"1999-01-01",E6-TODAY(),0),0)

and your workbook open procedure is shown below.

But I still think you have a problem. Say the Contract end date is 18/04/2015 a Saturday. That formula will only show 14 on Sat 4th April, and as I assume you won't be in on a Saturday, you won't open the workbook, the macro won't run when it's foirmula returns 1q4, and on the following Monday it will show 12. So it will be skipped.

Private Sub Workbook_Open()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double

    NotSentMsg = ""
    SentMsg = "Mail Sent"
    MyLimit = 14
    Set FormulaRange = Worksheets("Broker Agreements").UsedRange.Columns("F")

    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
    
        With FormulaCell
        
            If Not IsNumeric(.Value) Then
            
                MyMsg = "Not numeric"
            Else
            
                If .Value = MyLimit Then
                
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = NotSentMsg Then
                    
                        Call Mail_with_outlook2
                    End If
                Else
                
                    MyMsg = NotSentMsg
                End If
            End If
            
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell

ExitMacro:
    Application.EnableEvents = True
    Exit Sub

EndMacro:
    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description
    Resume ExitMacro
End Sub

[mykal66]

Hi guys - sorry it's taken a few days to come back to you, first day back after hols. Thank you for your help, I will have a play with the code you have given me and see how it goes

Mykal

[mperrah]

I had a project that was date specific needing emails sent.

I used this code in the sheet to display the items age in stock
cell D2 is the received date, the check on A2 limits empty row errors by not running script if that rows is empty.
the code is at the end of the row copied down.

=IF($A2="","",IF(30-(TODAY()-$D2)<=15,30-(TODAY()-$D2),""))

I used this to send and email when my inventory was 15 days old.
we had to pay on 30 days, so at 15 I sent an email of the status.
I added a command button on the sheet and assigned this macro to it.

Sub Mail_RcvrSheet()
'Working in 97-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
    'Copy the sheet to a new workbook
    Worksheets("Receivers").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
            'We exit the sub when your answer is NO in the security dialog that you only
            'see  when you copy a sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                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 If
    End With
 
        'Change all cells in the worksheet to values if you want
        With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail "youremail@email.com", _
                  "Review Needed Soon!"
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

hope this helps,

-mark